We help IT Professionals succeed at work.

Looping until empty

Stephen Byrom
on
HI Experts,
I have a problem I need help with.
I have studied the "Match" and "Vlookup" in excel but they seem to just "get" the cell information, and I want to "put" the information based on match or lookup, probably looping, I'm not sure which.

The Workbook has two sheets, Sheet1, Sheet2.
Sheet1 has static data;
Column A week numbers, Column B dates, column C text;
Row 1 has code numbers from D1 through AX1

Sheet 2 has data pasted to it each week, always starting from A2 (row 1 has headings) and when the data has been dealt with it is then cleared.
Column A has code numbers
Cell B2 has the date
Column C are numbers
Cell D2 has a number

This is probably a big ask, but I would like to automate the process of dealing with the data in sheet 2.

Process;
1. Look at the date in Sheet2 B2, and find the matching date down column B of Sheet1. The row number of this matched cell is now the entry row for the remaining data.
2. Copy Sheet2 D2 value, to column C in the entry row of Sheet1.
3. Look along row 1 in sheet1 until a cell matches A2 in Sheet2, then copy Sheet2 C2 value to the entry row in this matched column in Sheet1.
4. Delete row 2 in Sheet2.

Repeat steps 3 and 4 until no data is in A2 Sheet2.


As always, your time is much appreciated.

Comment
Watch Question

Could you post a workbook?
Stephen ByromWarehouse/Shipping

Author

Commented:
Thanks for the interest.
I have attached a workbook
ToyData---Copy.xlsx
I couldn't really test this because none of your data seemed to line up, but give it a try:
Sub x()
  
Dim rFind As Range, r As Range, rFind1 As Range
 
With Sheet2
    Set r = .Range("B2")
    Set rFind = Sheet1.Columns(2).Find(What:=r, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
        If Not rFind Is Nothing Then
            rFind.Offset(, 1).Value = r.Offset(, 2).Value
            Do Until IsEmpty(r)
                Set rFind1 = Sheet2.Rows(1).Find(What:=r.Offset(, -1), LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
                If Not rFind1 Is Nothing Then
                    r.Offset(, 1).Copy Sheet2.Cells(rFind.Row, rFind1.Column)
                End If
                r.EntireRow.Delete
                Set r = .Range("B2")
            Loop
        End If
End With
     
End Sub

Open in new window

Stephen ByromWarehouse/Shipping

Author

Commented:
Thank you for working on this for me.
I have changed the date in the data to be processed so that it finds a matching date in column b sheet 1.
It adds the number from D2 instead of C2 to the correct row in sheet 1 and deletes all the rows in sheet 2, but the numbers from column D sheet 2 are not transferred to sheet 1.
I have attached a new workbook with your macro inserted.
thanks again for your time.
ToyData---Copy.xlsm
Try this. Not sure about the D2/C2 as thought you said you wanted D2 copied over?
Sub x()
  
Dim rFind As Range, r As Range, rFind1 As Range
 
With Sheet2
    Set r = .Range("B2")
    Set rFind = Sheet1.Columns(2).Find(What:=r, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
        If Not rFind Is Nothing Then
            rFind.Offset(, 1).Value = r.Offset(, 1).Value
            Do Until IsEmpty(r)
                Set rFind1 = Sheet1.Rows(1).Find(What:=r.Offset(, -1), LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
                If Not rFind1 Is Nothing Then
                    r.Offset(, 1).Copy Sheet1.Cells(rFind.Row, rFind1.Column)
                End If
                r.EntireRow.Delete
                Set r = .Range("B2")
            Loop
        End If
End With
     
End Sub.

Open in new window

I think these two contradict each other, or am I missing something?

"2. Copy Sheet2 D2 value, to column C in the entry row of Sheet1.
3. Look along row 1 in sheet1 until a cell matches A2 in Sheet2, then copy Sheet2 C2 value to the entry row in this matched column in Sheet1."

"It adds the number from D2 instead of C2 to the correct row in sheet 1 and deletes all the rows in sheet 2, but the numbers from column D sheet 2 are not transferred to sheet 1."
Stephen ByromWarehouse/Shipping

Author

Commented:
Perfect!!
Thank you so much for your expertise.
Stephen ByromWarehouse/Shipping

Author

Commented:
Sorry for the confusion, I got cell/number blind.
I have been working on this all day and it's now 11.30, Time for bed I tthink.
:)
Thanks again for your time
No problem, glad it worked.
Stephen ByromWarehouse/Shipping

Author

Commented:
Just before I go to bed,
I have looked at the code you did for me and have learned a few things from it.
I should be able to do a loop or two myself in the future.
I will look at it in more detail tomorrow with fresh eyes.
Thanks for helping me learn a little more.

Explore More ContentExplore courses, solutions, and other research materials related to this topic.