VBA Excel: Don't Kknow right syntax to Set a variable's value 1

[RSJohnson]

I am matching data in cells on different worksheets in the same workbook. When the data matches I copy some data from sheet 1 to sheet 2.

If they do not match I insert a string where the data would have gone on sheet 2. In many cases there will be multiple records with the same unmatchable data element, I need cycle through all such records until I get to a different data element. The string is inserted during each iteration where the data would have gone on sheet 2.

When a new data element is reached and if that element turns out to be another element that has no match in sheet 1, I get a; Runtime error 91; ‘Object variable or with block variable not set’. The variable rngGMPCA has no value because a match to variable DAFRPCA could not be found. I have tried to assign a value to GMPCA but I am obviously not using the correct syntax. Can someone tell me how to assign a value to GMPCA at the ‘Set GMPCA …. ‘ line in the code below.



With Sheets("First QT").Range("B1:B2034")
Set rngGMPCA = .Find(rngDAFRPCA, LookIn:=xlValues)
'Moves to next GM PCA and test for match.
Set rngToCopy = rngToCopy.Offset(1, 0)

If rngGMPCA Is Nothing Then
'Records comment in cell with DAFR PCA to alert user
to non-matching problem all the DAFRPCAs have been tested
rngDestin = "No data retreived."
strEscape = rngDAFRPCA.Value

Do Until strEscape <> rngDAFRPCA.Value

'Moves to next GM PCA and test for match.
Set rngDAFRPCA = rngDAFRPCA.Offset(1, 0)
Set rngDestin = rngDestin.Offset(1, 0)
rngDestin = "No data retreived."
Loop

With Sheets("First QT").Range("B1:B2034")
Set rngGMPCA = .Find(rngDAFRPCA, LookIn:=xlValues)

If rngGMPCA Is Nothing Then
'Set rngGMPCA =
End If

Set rngToCopy = rngToCopy.Offset(1, 0)
Set rngDestin = rngDestin.Offset(1, 0)

End With
End If
End With
End If
Loop
End Sub

 

[RSJohnson]

The first rngCopy should be CB4:CE4 on QT. The code is getting rngGMPCA from B4 on QT as it should.


Does the following statement say do something at R13708 not R2 where it should start?
Set rngDestin = wsPE.Cells(.Rows.Count + .Row, "R")

 

[SkipVought]

ith wsPE.UsedRange
  Set rngDestin = wsPE.Cells(.Rows.Count + .Row, "R")
End With

says look at the ENTIRE USED RANGE on the PE Sheet and set rngDestin to the NEXT ROW AFTER the ENTIRE USED RANGE in col R.

How does the pgm know that the row should be ROW 2 or any other row???

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[RSJohnson]

How would you determine what the "ENTIRE USED RANGE on the PE Sheet" is?

In my orginal code I initialized variables outside the loop. With the following code;
'This initializes the variable for the first match.
Set rngDAFRPCA = Sheets("Prepared_Expense").Range("Q2").Offset(1, -15) 'Range _
Set rngGMPCA = Sheets("First QT").Range("B4") 'Change to variable!
Set rngToCopy = Sheets("First QT").Range("CB4:CE4") 'Change to variable!
Set rngDestin = Sheets("Prepared_Expense").Range("R2") 'Range must be in same row as _
the start of DAFRPCA data.

I incremented the variables that needed to changed with each success from within the Do Loop with this code.

Do Until intCounter = intStop
If rngDAFRPCA = rngGMPCA Then
Sheets("First QT").Select
rngToCopy.Select
Selection.Copy
Sheets("Prepared_Expense").Select
rngDestin.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

'Moves to next row in the expense worksheet and the next destination cell.
Set rngDAFRPCA = rngDAFRPCA.Offset(1, 0)
Set rngDestin = rngDestin.Offset(1, 0)

'Increments counter.
intCounter = intCounter + 1

I do not have the expertise relative to the code you provided to answer your question about how this program knows "that the row should be ROW 2 or any other row???"

 

[SkipVought]

Check out UsedRange in help.

I think that I made an incorrect assumption. Rather than the PASTE range being at the bottom of the UsedRange, it is the row of the matched value.

              With rngDAFRPCA
                r = 1
                Do While (.Offset(r, 0).Value = rngGMPCA.Value)
                  
                    Set rngToCopy = Range(wsQT.Cells(.Row, "CB"), wsQT.Cells(.Row, "CE"))
                    Set rngDestin = wsPE.Cells(.Rows.Count + .Row, "R")
                    rngToCopy.Copy Destination:=rngDestin
                    r = r + 1
                  Loop
              End With

I may have had the wrong object for Set rngDestin

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[RSJohnson]

Skip,

I will make to code changes on the train and will get back to you when I get home. I have to go to catch my train. I stayed late yesterday and caught the last one but I can't do that today

 

[RSJohnson]

Skip,

I misspoke in my last message. I thought that there was code changes in the box in your last message, there weren't so I have changed nothing.

 

[SkipVought]

there IS a code change!

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[RSJohnson]

This is what the code looks like.
It is still adding a row with each increment of the Do Loop at the end of the records on PE and no data is being transfered from QT to PE.


Sub PCA()
Dim wsPE As Worksheet, wsQT As Worksheet

Set wsPE = Sheets("Prepared_Expense")
Set wsQT = Sheets("First QT")

With wsQT.Range("B1:B2034")
For Each rngDAFRPCA In Range(wsPE.Range("B2"), wsPE.Range("B2").End(xlDown))
Set rngGMPCA = .Find(rngDAFRPCA, LookIn:=xlValues)
If Not rngGMPCA Is Nothing Then
'found
'With rngGMPCA
With rngDAFRPCA
r = 1
Do While (.Offset(r, 0).Value = rngGMPCA.Value)

Set rngToCopy = Range(wsQT.Cells(.Row, "CB"), wsQT.Cells(.Row, "CE"))
Set rngDestin = wsPE.Cells(.Rows.Count + .Row, "R")
rngToCopy.Copy Destination:=rngDestin
r = r + 1
Loop
End With

Else
'not found -- ITS NOT CLEAR WHAT Dest SHOULD BE

With wsPE.UsedRange
Set rngDestin = wsPE.Cells(.Rows.Count + .Row, "R")
Sheets("Prepared_Expense").Range(Dest).Value = "No data retrieved"
End With
With wsPE.UsedRange
wsPE.Cells(.Rows.Count + .Row, "R").Value = "No data retrieved"

End With
End If
Next
End With
End Sub

 

[SkipVought]

See if this works

    With wsQT.Range("B1:B2034")
        For Each rngDAFRPCA In Range(wsPE.Range("B2"), wsPE.Range("B2").End(xlDown))
            Set rngGMPCA = .Find(rngDAFRPCA, LookIn:=xlValues)
            If Not rngGMPCA Is Nothing Then
              'found
                r = 1
                Do While (.Offset(r, 0).Value = rngGMPCA.Value)
                    With rngGMPCA
                     'the ToCopy ROW is the rngGMPCA row
                      Set rngToCopy = Range(wsQT.Cells(.Row, "CB"), wsQT.Cells(.Row, "CE"))
                    End With
                    With rngDAFRPCA
                     'the Destination ROW is the rngDAFRPCA row
                      Set rngDestin = wsPE.Cells(.Row, "R")
                    End With
                    rngToCopy.Copy Destination:=rngDestin
                    r = r + 1
                Loop
                           
            Else
            'not found
                With rngDAFRPCA
                'the Destination ROW is the rngDAFRPCA row
                    wsPE.Cells(.Row, "R").Value = "No data retrieved"
                End With
            End If
        Next
    End With

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[RSJohnson]

I get a type mismatch error at;
Do While (.Offset(r, 0).Value = rngGMPCA.Value)

The Loop is iterating through DAFRPCAs as long as the DAFRPCA equals the GMPCA. Is it necessary to tell the program that's dealing with rngDAFRPCA somewhere before the loop?

When the Loop ends does the program get the next DAFARPCA and start over at the For Next or does it go to Else?

 

[SkipVought]

Please post an example of the column B data on both sheets.

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[RSJohnson]

The value in cell B4 on wsFirst QT is A100. The value in cell B2 on wsPrepared_Expense is A100.

I have created awork book with a wsQT and a wsPE with enough real data to test all the things the program should.

Would you like it? If so how do I get it to you?

My email address is robert_s_johnson1944@netzero.net

 

[SkipVought]

I sent you an eMail.

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[SkipVought]

I changed the logic to loop thru the SINGLE VALUES as listed on your QT sheet then use that value to MATCH a value on the PE Sheet and Do...Loop until a match no longer occurs.

Sub PCA()
Dim wsPE As Worksheet, wsQT As Worksheet, ptr As Variant, rngPE As Range, rngQT As Range

Set wsPE = Sheets("Prepared_Expense")
Set wsQT = Sheets("First QT")
Set rngPE = Range(wsPE.Cells(2, "B"), wsPE.Cells(2, "B").End(xlDown))
Set rngQT = Range(wsQT.Cells(4, "B"), wsQT.Cells(4, "B").End(xlDown))
  
    With rngPE
        For Each rngGMPCA In rngQT
            ptr = Application.Match(rngGMPCA.Value, rngPE, 0)
            If Not IsError(ptr) Then
              'found
                With rngGMPCA
                 'the ToCopy ROW is the rngGMPCA row
                  Set rngToCopy = Range(wsQT.Cells(.Row, "CB"), wsQT.Cells(.Row, "CE"))
                End With
                r = 0
                Do While (Application.Index(rngPE, ptr + r, 1) = rngGMPCA.Value)
                    'the Destination ROW is the ptr row
                     Set rngDestin = wsPE.Cells(.Row + ptr + r - 1, "R")
                    rngToCopy.Copy
                    rngDestin.PasteSpecial xlPasteValues
                    r = r + 1
                Loop
                           
            Else
            'not found
                With rngGMPCA
                'the Destination ROW is on the QT sheet
                    wsQT.Cells(.Row, "CF").Value = "No data copied"
                End With
            End If
        Next
    End With
End Sub

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[SkipVought]

robert,

As I was debugging, I changed some things. Please substitute this statement where appropriate

Set rngPE = Range(wsPE.Cells(1, "B"), wsPE.Cells(1, "B").End(xlDown))

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[RSJohnson]

Skip,

The program runs until it gets to about line 5700+ then it gets into some sort of loop going down to row 6800+ then back upto 5700+. It cycles through the loop 3 or 4 times and then my notebook crashes.
I am looking at the data in the region where the fatal loop starts and ends to see what the PCAs look like. l

The "No data ..." string needs to be on PE at the appropriate row.

 

[SkipVought]

I have really spent FAR more time than I ought on your problem.

At this point, you ought to be able to carry the ball on your own. I gave you a loop that works.

This is NOT a help desk!

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[VBAjedi]

semaphore,

Skip is one of the most knowledgeable Tek-Tippers on the entire site. I don't remember ever having seen someone be more patient and persistent than Skip has been with this thread. He gave you over TEN extensive code examples.

I see at LEAST three posts of his that helped you along your way - you should give him stars for each one. I don't even see a single "Thanks" from you. . .

None of us get paid to offer assistance in this forum. You would do well to learn the value of expressing gratitude at every opportunity (even before your problem is completely solved). Tipmasters really do find a measure of satisfaction and fulfillment in those little star icons - it means that someone found our efforts to be helpful and took the time to say so.

I fully believe that you can do better!

VBAjedi

 

[RSJohnson]

I was unaware that I had violated this forum's code of behavior. I though that Skip and I were involved in one entended conversation. Where I come from you thank people at the end of a conversation or when an issues is resolved not after each sentence.

 

[RSJohnson]

Skip,

I read the last post before I read yours. I sencerely thank you all the time and effort you put into helping me. I apologuize if I abused your genererous sharing of your knowledge.

Once again thanks.