need this to loop

[wafs]

I have this going through a source sheet once, but I need it to loop through. I have to have output(7) look at every output(1) before it makes a loop. What am I missing to get the code to do this.

output(7) = "CA" + r 'dest sheet part numbers
output(8) = sheets(destsh).Range(output(7)).Text
output(1) = "A" + r 'part numbers
output(2) = sheets(notes).Range(output(1)).Value
TestRange8 = output(2)
output(5) = "C" + r 'comments
output(6) = sheets(notes).Range(output(5)).Text
TestRange7 = output(6)

For x = 1 To 4000

If UCase(Trim(sheets(destsh).Range(output(7)))) = UCase(Trim(sheets(notes).Range(output(1)).Value)) And UCase(Trim(sheets(notes).Range(output(5)).Text)) <> "" Then
c = c + 1
y = c + 103 'Tells where to start importing comments
reportlocation = "A" + y 'Starting row of comments
sheets(notes).Range(output(1)).Copy sheets(destsh).Range(reportlocation)
reportlocation = "B" + y 'comments
sheets(notes).Range(output(5)).Copy sheets(destsh).Range(reportlocation)
r = r + 1
output(5) = "C" + r 'Testrange7
output(1) = "A" + r 'TestRange8
Else
r = r + 1
output(5) = "C" + r
output(1) = "A" + r
End If
Next
output(7) = "CA" + r

 

[SkipVought]

What is it doing that it should not be doing?

What is it not doing that it should be doing?

Your array adds no value to the process. Take a look at this...

    Dim iColPN2 As Integer, iColPN1 As Integer, iColCmt As Integer, iColRpt As Integer
    Dim wsdes As Worksheet, wsnot As Worksheet
    
    Set wsdes = Sheets(destsh)
    Set wsnot = Sheets(notes)
    
    iColPN1 = [A].Column
    iColRpt = [B].Column
    iColCmt = [C].Column
    iColPN2 = [CA].Column
    
                
    For x = 1 To 4000
        
        If UCase(Trim(wsdes.Cells(r, iColPN2).Value)) = _
            UCase(Trim(wsnot.Cells(r, iColPN1).Value)) And _
            UCase(Trim(wsnot.Cells(r, iColCmt).Value)) <> "" Then

            C = C + 1
            y = C + 103   'Tells where to start importing comments
            
            wsnot.Cells(r, iColPN1).Copy wsdes.Cells(y, iColPN2)
            
            Sheets(notes).Cells(r, iColCmt).Copy wsdes.Cells(y, iColRpt)
        End If
        r = r + 1
    Next

Skip,

_{[red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
POULTRY in motion to PULLET for a PALTRY amount!}

 

[SkipVought]

...and depending on the FIRST ROW that you want to process, get rid of x

    Dim iColPN2 As Integer, iColPN1 As Integer, iColCmt As Integer, iColRpt As Integer
    Dim wsdes As Worksheet, wsnot As Worksheet
    
    Set wsdes = Sheets(destsh)
    Set wsnot = Sheets(notes)
    
    iColPN1 = [A].Column
    iColRpt = [B].Column
    iColCmt = [C].Column
    iColPN2 = [CA].Column
    
                
    For r = 1 To 4000
        
        If UCase(Trim(wsdes.Cells(r, iColPN2).Value)) = _
            UCase(Trim(wsnot.Cells(r, iColPN1).Value)) And _
            UCase(Trim(wsnot.Cells(r, iColCmt).Value)) <> "" Then

            C = C + 1
            y = C + 103   'Tells where to start importing comments
            
            wsnot.Cells(r, iColPN1).Copy wsdes.Cells(y, iColPN2)
            
            Sheets(notes).Cells(r, iColCmt).Copy wsdes.Cells(y, iColRpt)
        End If
    Next

and what is c doing?

Skip,

_{[red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
POULTRY in motion to PULLET for a PALTRY amount!}

 

[wafs]

What the macro needs to do is look up "CA" in notes and match, then copy over the information to "A". It goes throught the sheet once and copies over the information, but does not go through the sheet once. I need CA to increment and keep going through the notes sheet until all in CA are matched. Bascially, I need it to loop through column CA and match against notes then copy the information to the destsh.

c is the rows where the copy information needs to be placed.

Dim cellstart As Integer 'starting point of informaiton (row)
Dim commentstart As Integer 'starting point for comments (row)
Dim p As Integer
Dim c As Integer 'for comments
Dim h As Integer 'for comments
Dim x As Integer
Dim r As String 'counting variable for comments
Dim n As String 'counting variable
Dim TestRange As String 'Test String
Dim TestRange2 As String 'Test String
Dim TestRange3 As String 'Test String
Dim TestRange4 As String
Dim TestRange5 As String
Dim TestRange6 As String 'Test String for notes
Dim TestRange7 As String 'Test String for notes
Dim TestRange8 As String 'Test String for notes
Dim TestRange9 As String 'test string for notes
Dim m As String
Dim y As String 'for comments
Dim t As Integer 'for comments
Dim sh As String 'source sheet
Dim destsh As String 'dest sheet
Dim notes As String 'source sheet for comments
Dim reportlocation As String
Dim reportlocation2 As String
Dim header As String 'header you want to run Holds header
Dim output(1 To 8) As String

cellstart = 3 'Starting point of source sheet
commentsstart = 2 'starting point for comments increase this number only if you need more comment space
partstart = 3 'starting point of dest sheet for comments
p = 0
c = 0
header = InputBox("Which header do you want to run?", "header") 'input the requested header

TestRange = header
sh = "Daily" 'Work sheet where the header information is kept
destsh = header ' desination sheet for header
notes = "Notes" 'work sheet for notes

n = cellstart
For x = 1 To 1000 'increase this number only if daily sheet has more than 1000 parts
TestRange2 = "B" + n 'column where to match header request
TestRange3 = "A" + n 'part number
TestRange4 = "AF" + n 'over 60 days
TestRange5 = "AE" + n 'furture 6

If UCase(Trim(TestRange)) = UCase(Trim(sheets(sh).Range(TestRange2))) And UCase(Trim(sheets(sh).Range(TestRange4) < 61)) Then
p = p + 1
m = p + 3 'Tells where to start importing information on dest sheet
reportlocation = "A" + m 'starting point of output file
sheets(sh).Range(TestRange3).Copy sheets(destsh).Range(reportlocation)
n = n + 1
TestRange2 = "B" + n
TestRange3 = "A" + n
TestRange4 = "AF" + n
TestRange5 = "AE" + n
Next

output(7) = "CA" + r 'dest sheet part numbers
output(8) = sheets(destsh).Range(output(7)).Text
output(1) = "A" + r 'part numbers
output(2) = sheets(notes).Range(output(1)).Value
TestRange8 = output(2)
output(5) = "C" + r 'comments
output(6) = sheets(notes).Range(output(5)).Text
TestRange7 = output(6)

For x = 1 To 4000

If UCase(Trim(sheets(destsh).Range(output(7)))) = UCase(Trim(sheets(notes).Range(output(1)).Value)) And UCase(Trim(sheets(notes).Range(output(5)).Text)) <> "" Then
c = c + 1
y = c + 103 'Tells where to start importing comments
reportlocation = "A" + y 'Starting row of comments
sheets(notes).Range(output(1)).Copy sheets(destsh).Range(reportlocation)
reportlocation = "B" + y 'comments
sheets(notes).Range(output(5)).Copy sheets(destsh).Range(reportlocation)
r = r + 1
output(5) = "C" + r 'Testrange7
output(1) = "A" + r 'TestRange8
Else
r = r + 1
output(5) = "C" + r
output(1) = "A" + r
End If
Next
output(7) = "CA" + r

 

[SkipVought]

"It goes throught the sheet once and copies over the information, but does not go through the sheet once. "

Does that make sense to you? It does not make sense to me!

Skip,

_{[red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
POULTRY in motion to PULLET for a PALTRY amount!}

 

[wafs]

Sorry, figures slower than brain. It goes through the sheet only once when there are numerous part numbers (CA) that need to be looked up and matched to a comment.

 

[SkipVought]

Please post a small sample of data that illustrates this issue.

Skip,

_{[red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
POULTRY in motion to PULLET for a PALTRY amount!}

 

[wafs]

Here is an example from a worksheet. I can't get the code to go and look for the next two part numbers.

Part Number EAU Point Type

24504717 496,800 H
11500718 8,380,500 H
N807834S 15,494,000 DP

TOTALS 24,371,300

Comments
24504717 GM7114M/FT PARTS DUE MID APRIL CONTINUE TO MAKE 24502097 UNTIL CHANGE

 

[SkipVought]

pretend like I'm an idiot. tell me what ROW in the sheet this all is, what part number IS being processed and what is NOT.

Skip,

_{[red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
POULTRY in motion to PULLET for a PALTRY amount!}

 

[wafs]

You are not an idiot. You help me way to much to be one.

The data starts on column A row 4

Part Number EAU Point Type

The comments start on column A row 104

Part number 24504717 is being processed and

11500718 & N807834S is not being processed.

I have the part number copied over to Column CA row 4 to be the location for the code to look at when comparing part numbers to the notes sheet.

Notes sheet
(Column A row 4 is where the comments start)
Part number header Comments
(not used)
N807834S 7027 P.C.DUB/S8
11518613 7027 CC DUBOIS
N808841S301 5123
N808841S439 5123
VP6ASH19G406AA 5123 CC-S438 BLACK

 

[SkipVought]

1. Is there a comment for each of these 2 PNs?

2. Are the PN values EXACTLY the same? (no leading or trailing characters like SPACES)

Skip,

_{[red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
POULTRY in motion to PULLET for a PALTRY amount!}

 

[wafs]

Yes there are comments for each of these two PN. But not all PN will have comments.

There could be trailing characters (like spaces) after the PN. some PN have trailers some don't.

 

[SkipVought]

Trailing spaces can be a problem, but then you're using Trim & UCase in your compare.

If the trailing characters are NOT SPACES, for instance, they are values copied and pasted in, containing non-printable characters other than spaces, then iit can be a REAL PROBLEM.

I'd try using the Find method, rather than this 103 row offset.

Are the PN, Comments in the correct order with the same relative row offset?

Skip,

_{[red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
POULTRY in motion to PULLET for a PALTRY amount!}

 

[wafs]

Not sure, will have to look it up. Will work on the find method and let you know how it turns out.

 

[wafs]

Here is my find method and now I get an error at the end of the code.

Runtime error 1004 can't findnext property or method

Any guess on what I'm missing or over looking?

Sub update_headers()

'====================================================================
' UPDATE HEADER SHEETS
'
'Description: Automatically updates header sheets with header you request
'
'Macro Created on 3/16/2006
'
'Written by Wendy Smith
'=========================================================================

Dim cellstart As Integer 'starting point of informaiton (row)
Dim commentstart As Integer 'starting point for comments (row)
Dim p As Integer
Dim c As Integer 'for comments
Dim h As Integer 'for comments
Dim x As Integer
Dim r As String 'counting variable for comments
Dim n As String 'counting variable
Dim TestRange As String 'Test String
Dim TestRange2 As String 'Test String
Dim TestRange3 As String 'Test String
Dim TestRange4 As String
Dim TestRange5 As String
Dim TestRange6 As String 'Test String for notes
Dim TestRange7 As String 'Test String for notes
Dim TestRange8 As String 'Test String for notes
Dim TestRange9 As String 'test string for notes
Dim m As String
Dim y As String 'for comments
Dim sh As String 'source sheet
Dim destsh As String 'dest sheet
Dim notes As String 'source sheet for comments
Dim reportlocation As String
Dim sFirstAddress As String
Dim header As String 'header you want to run Holds header
Dim output(1 To 8) As String
Dim myrange As Range
Dim rsearch As Range

cellstart = 3 'Starting point of source sheet
commentsstart = 4 'starting point for comments increase this number only if you need more comment space
p = 0
c = 0
header = InputBox("Which header do you want to run?", "header") 'input the requested header

TestRange = header
sh = "Daily" 'Work sheet where the header information is kept
destsh = header ' desination sheet for header
notes = "Notes" 'work sheet for notes

'Clear out old Data and unhide rows

sheets(destsh).Range("A4:A100").Select
Selection.ClearContents
Selection.EntireRow.Hidden = False

n = cellstart
r = commentsstart

TestRange2 = "B" + n 'column where to match header request
TestRange3 = "A" + n 'part number
TestRange4 = "AF" + n 'over 60 days
TestRange5 = "AE" + n 'furture 6
For x = 1 To 1000 'increase this number only if daily sheet has more than 1000 parts
If UCase(Trim(TestRange)) = UCase(Trim(sheets(sh).Range(TestRange2))) And UCase(Trim(sheets(sh).Range(TestRange4) < 61)) Then
p = p + 1
m = p + 3 'Tells where to start importing information on dest sheet
reportlocation = "A" + m 'starting point of output file
sheets(sh).Range(TestRange3).Copy sheets(destsh).Range(reportlocation)
reportlocation = "CA" + m
sheets(sh).Range(TestRange3).Copy sheets(destsh).Range(reportlocation)
n = n + 1
TestRange2 = "B" + n
TestRange3 = "A" + n
TestRange4 = "AF" + n
TestRange5 = "AE" + n
ElseIf UCase(Trim(TestRange)) = UCase(Trim(sheets(sh).Range(TestRange2))) And UCase(Trim(sheets(sh).Range(TestRange4) > 60)) And UCase(Trim(sheets(sh).Range(TestRange5) > 0)) Then
p = p + 1
m = p + 3 'Tells where to start importing information on dest sheet
reportlocation = "A" + m 'starting point of output file
sheets(sh).Range(TestRange3).Copy sheets(destsh).Range(reportlocation)
reportlocation = "CA" + m
sheets(sh).Range(TestRange3).Copy sheets(destsh).Range(reportlocation)
n = n + 1
TestRange2 = "B" + n
TestRange3 = "A" + n
TestRange4 = "AF" + n
TestRange5 = "AE" + n
Else
n = n + 1
TestRange2 = "B" + n
TestRange3 = "A" + n
TestRange4 = "AF" + n
TestRange5 = "AE" + n

End If
Next

'Hide empty rows
m = m + 1
reportlocation = "A" + m
Do While sheets(destsh).Range(reportlocation).Value = ""
sheets(destsh).Range(reportlocation).EntireRow.Hidden = True
m = m + 1
reportlocation = "A" + m
Loop

'Move Comments
sheets(destsh).Range("A104:B204").Select
Selection.ClearContents

output(7) = "CA" + r 'dest sheet part numbers
output(8) = sheets(destsh).Range(output(7)).Text
TestRange9 = output(8)
output(1) = "A" + r 'part numbers
output(2) = sheets(notes).Range(output(1)).Value
TestRange8 = output(2)
output(5) = "C" + r 'comments
output(6) = sheets(notes).Range(output(5)).Text
TestRange7 = output(6)



Set myrange = sheets(destsh).Range(output(7))
Set rsearch = sheets(notes).Range(output(1))
' Set rsearch = rsearch.Find(what:=sheets(destsh).Range(output(1)).UsedRange)
If Not myrange Is Nothing Then

sFirstAddress = rsearch.Address
Do
If sheets(notes).Range(output(5)) <> "" Then

c = c + 1
y = c + 103 'Tells where to start importing comments
reportlocation = "A" + y 'Starting row of part numbers for comments
sheets(notes).Range(output(1)).Copy sheets(destsh).Range(reportlocation)
reportlocation = "B" + y 'comments
sheets(notes).Range(output(5)).Copy sheets(destsh).Range(reportlocation)
-----------------> Set rsearch = myrange.FindNext(rsearch)
End If

Loop Until rsearch.Address = sFirstAddress
End If


End Sub

Example

Part Number EAU

N807834S 15,494,000
11500718 8,380,500
24504717 496,800
TOTALS 24,371,300


Comments
11518613 CC DUBOIS

 

[wafs]

I fixed the above problem, but now it does not loop.

example

N807834S 15,494,000
11500718 8,380,500
24504717 496,800
TOTALS 24,371,300

Comments
N807834S CC DUBOIS


Sub update_headers()

'====================================================================
' UPDATE HEADER SHEETS
'
'Description: Automatically updates header sheets with header you request
'
'Macro Created on 3/16/2006
'
'Written by Wendy Smith
'=========================================================================

Dim cellstart As Integer 'starting point of informaiton (row)
Dim commentstart As Integer 'starting point for comments (row)
Dim p As Integer
Dim c As Integer 'for comments
Dim h As Integer 'for comments
Dim x As Integer
Dim r As String 'counting variable for comments
Dim n As String 'counting variable
Dim TestRange As String 'Test String
Dim TestRange2 As String 'Test String
Dim TestRange3 As String 'Test String
Dim TestRange4 As String
Dim TestRange5 As String
Dim TestRange6 As String 'Test String for notes
Dim TestRange7 As String 'Test String for notes
Dim TestRange8 As String 'Test String for notes
Dim TestRange9 As String 'test string for notes
Dim m As String
Dim y As String 'for comments
Dim sh As String 'source sheet
Dim destsh As String 'dest sheet
Dim notes As String 'source sheet for comments
Dim reportlocation As String
Dim sFirstAddress As String
Dim header As String 'header you want to run Holds header
Dim output(1 To 8) As String
Dim myrange As Range
Dim rsearch As Range

cellstart = 3 'Starting point of source sheet
commentsstart = 4 'starting point for comments increase this number only if you need more comment space
p = 0
c = 0
header = InputBox("Which header do you want to run?", "header") 'input the requested header

TestRange = header
sh = "Daily" 'Work sheet where the header information is kept
destsh = header ' desination sheet for header
notes = "Notes" 'work sheet for notes

'Clear out old Data and unhide rows

sheets(destsh).Range("A4:A100").Select
Selection.ClearContents
Selection.EntireRow.Hidden = False

n = cellstart
r = commentsstart

TestRange2 = "B" + n 'column where to match header request
TestRange3 = "A" + n 'part number
TestRange4 = "AF" + n 'over 60 days
TestRange5 = "AE" + n 'furture 6
For x = 1 To 1000 'increase this number only if daily sheet has more than 1000 parts
If UCase(Trim(TestRange)) = UCase(Trim(sheets(sh).Range(TestRange2))) And UCase(Trim(sheets(sh).Range(TestRange4) < 61)) Then
p = p + 1
m = p + 3 'Tells where to start importing information on dest sheet
reportlocation = "A" + m 'starting point of output file
sheets(sh).Range(TestRange3).Copy sheets(destsh).Range(reportlocation)
reportlocation = "CA" + m
sheets(sh).Range(TestRange3).Copy sheets(destsh).Range(reportlocation)
n = n + 1
TestRange2 = "B" + n
TestRange3 = "A" + n
TestRange4 = "AF" + n
TestRange5 = "AE" + n
ElseIf UCase(Trim(TestRange)) = UCase(Trim(sheets(sh).Range(TestRange2))) And UCase(Trim(sheets(sh).Range(TestRange4) > 60)) And UCase(Trim(sheets(sh).Range(TestRange5) > 0)) Then
p = p + 1
m = p + 3 'Tells where to start importing information on dest sheet
reportlocation = "A" + m 'starting point of output file
sheets(sh).Range(TestRange3).Copy sheets(destsh).Range(reportlocation)
reportlocation = "CA" + m
sheets(sh).Range(TestRange3).Copy sheets(destsh).Range(reportlocation)
n = n + 1
TestRange2 = "B" + n
TestRange3 = "A" + n
TestRange4 = "AF" + n
TestRange5 = "AE" + n
Else
n = n + 1
TestRange2 = "B" + n
TestRange3 = "A" + n
TestRange4 = "AF" + n
TestRange5 = "AE" + n

End If
Next

'Hide empty rows
m = m + 1
reportlocation = "A" + m
Do While sheets(destsh).Range(reportlocation).Value = ""
sheets(destsh).Range(reportlocation).EntireRow.Hidden = True
m = m + 1
reportlocation = "A" + m
Loop

'Move Comments
sheets(destsh).Range("A104:B204").Select
Selection.ClearContents

output(7) = "CA" + r 'dest sheet part numbers
output(8) = sheets(destsh).Range(output(7)).Text
TestRange9 = output(8)
output(1) = "A" + r 'part numbers
output(2) = sheets(notes).Range(output(1)).Value
TestRange8 = output(2)
output(5) = "C" + r 'comments
output(6) = sheets(notes).Range(output(5)).Text
TestRange7 = output(6)



Set myrange = sheets(destsh).Range(output(7))
Set rsearch = sheets(notes).Range(output(1))
Set rsearch = myrange.Find(what:=sheets(destsh).Range(output(7)), after:=myrange.Cells(myrange.Cells.Count), lookat:=xlWhole)
If Not myrange Is Nothing Then

sFirstAddress = rsearch.Address
Do
If rsearch = myrange And sheets(notes).Range(output(5)) <> "" Then

c = c + 1
y = c + 103 'Tells where to start importing comments
reportlocation = "A" + y 'Starting row of part numbers for comments
rsearch.Copy sheets(destsh).Range(reportlocation)
reportlocation = "B" + y 'comments
sheets(notes).Range(output(5)).Copy sheets(destsh).Range(reportlocation)
Set myrange = rsearch.FindNext(myrange)
End If

---------> Loop Until rsearch.Address = sFirstAddress
End If


End Sub

 

[SkipVought]

Put one or more BREAKS in your code.

Step thru essential code to observe whats happening.

Use the Watch Window to observe specific values.

Look at my FAQ on using the Watch Window if you need to.

Skip,

_{[red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
POULTRY in motion to PULLET for a PALTRY amount!}

 

[wafs]

I have several breaks in the code and it hits the loop part of the code, but never loops back to the if search. the code hits the loop then goes to end if then end sub.

 

[SkipVought]

You never set rsearch to anything else.

So set the SearchRange and...

   Set rsearch= SearchRange.FindNext(rsearch)

Skip,

_{[red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
POULTRY in motion to PULLET for a PALTRY amount!}

 

[wafs]

OK. I got it to work another way, but it is a lot of code. I will give you suggestion a try.