Help with a search and replace routine.

B

BACK2BASIC

New member
Joined
Oct 14, 2013
Messages
25
Reaction score
0
Points
0
Hello all.
Would someone be willing to help me refine my search and replace routine? The programming is getting beyond my capabilities. It has been working fine until the schedulers added a new column to the report. Please allow me to explain:

I have two excel spreadsheets which are essentially identical except for the comment field. Each week a new spreadsheet comes out (Sheet A). Employees are to update the comments on their jobs from the previous old spreadsheet (Sheet B). I have written a VB routine to do this by simply extracting the job number in sheet A and searching for the same job number in sheet B. I then go to the comment field in sheet B and paste it in the same respective spot in the new sheet A. Below is the code to do this

The problem I am having now is our scheduling department has added a new field to the job. So now I have to make sure two fields match. Can you please help to modify the underlined statement to search for two fields to match simultaneously. They must match so I can be sure the comment is the correct one.

Code: 
Public Sub Process_billing_data()
 
 Dim CG As String
 Dim GCell As Range
 Dim x, y, z As Integer
 Dim Mypath$, Mycomment$
 x = 1
 TestER = False
  
  Sheets("Report out").Activate


   
   For i = 2 To 100
       
        CG = Cells(x, 5) ' Get the Job number
        Sheets("JL").Activate
[U]        Set GCell = ActiveSheet.Cells.Find(CG)[/U]
            If Not GCell Is Nothing Then
                With GCell
                On Error GoTo ErrorHandler
                        
                Mycomment$ = .Offset(0, 6).Value
              
                End With
                
                Sheets("Report out").Activate
                With ThisWorkbook.ActiveSheet.Cells(x, 1)
                .Offset(0, 6).Value = Mycomment$
                End With
            Else
            MsgBox ("Loop Stopped")
            Sheets("Report out").Activate
            End If
        x = x + 1
        Next i


ActiveWorkbook.Close SaveChanges:=True


ErrorHandler:
TestER = True
Resume Next
End Sub
 
Last edited:
could you upload a sample workbook that this code refers to?
I do a similar thing with some sheets I work with daily.
There is a lot of simplification we could do with your code.
 
Simi said:
could you upload a sample workbook that this code refers to?
I do a similar thing with some sheets I work with daily.
There is a lot of simplification we could do with your code.
Click to expand...

I have uploaded the Excel SS file: Schedule 2_10_14. Sheet "Report Out" is the new sheet with no comments. Sheet "Schd complete" is the previous weeks report with the comments that need to be extracted and placed into Sheet "Report out". Field H is the new Field added to the report which is making it difficult for me. Because now both Field A and Field H must match. There can be several identical Field A and several different field B. Thank you for help in any way you can.
 

Attachments

  • Schedule 2_10_14.xlsm
    54.6 KB · Views: 12
I have made a new sub for you to run, check it out Sub simi_report_out()

Also, just for clarification. This takes the comments from the "Schd complete" tab and moves them to the "Report out" tab if both column A and H match.
 

Attachments

  • Schedule 2_10_14-Simi.xlsm
    55.2 KB · Views: 22
Simi said:
I have made a new sub for you to run, check it out Sub simi_report_out()

Also, just for clarification. This takes the comments from the "Schd complete" tab and moves them to the "Report out" tab if both column A and H match.
Click to expand...

OMG! This is beautiful code. You are so kind to help me and write this routine. It works great! I must be honest, it is very efficient and I need to run it a few times to understand fully how it works.

THANK YOU!
 
I'm glad you liked it.
I didn't know if the data you had, needed to be in any particular order and sorting before running my comparisons makes it lots faster.
So I added a counter in column R to use to sort it back to the original sorting after I ran the comparisons and copied data.
I should have probably commented out the lCounter = lCounter +1 line so it could skip that step, I was using that for testing efficiency.
I had 2 nested for/next instead of the for and do you see. The 2 nested for loops had over 11,000 iterations, where the current version had less than 200 making it much more efficient.
If you have any questions about the code I would love to answer them to help you learn.
 
BACK2BASIC said:
OMG! This is beautiful code. You are so kind to help me and write this routine. It works great! I must be honest, it is very efficient and I need to run it a few times to understand fully how it works.

THANK YOU!
Click to expand...

Hi, there is one issue, sorry I was not clear on and I am trying to figure out the best way to fix. Even though for the most part the two sheets are equal, the new job sheet (Report out - Sheet 1) that is generated each week could and will have more or less jobs on it then the previous week (Schd complete - Sheet 2).

This is because jobs get added each week and deleted as they are completed. Therefore, the sort order can be different and throws off the entire count? The only way I can think of to fix this is to take each row from sheet A (Report out) and search each row in sheet B (Schd completed). In others, the routine must run through the loop the total number of rows in (Sheet B) Schd complete searching every row in Sheet A (Report out). Do you agree?
 
We were writing to each other at the same time. I just got your message. Thank you and yes I will have some questions. I need to understand and digest this code first. If you are willing to help me learn more that is awesome because I do want to become better. Your code is much more understandable and simpler. I am a crude step by step programmer.
 
The way this macro works.

1. I add column R on both sheets and simply put the current row number in cell R2 down to R(the last row with data). This is so I can resort the sheets back to the original sorting.
2. I then cycle through all of the items from sheet1, "Report Out" this is the For/Next block.
3. The Do While loop cycles through all of the items on sheet2, "Schd complete" until it finds a match. (I think this may be where your problem is, if there isn't a match we need to reset the row counter lRowCurrent2 back to 2 to start from the top of sheet2 again for the next item from sheet1)
4. If there is a match in both column A and H it copies the data from Q, then moves to the next row in sheet1.

Replace this portion of the code with this.
Code: 
lRowCurrent2 = 2
For lRowCurrent1 = 2 To lRowMax1
    Do While lRowCurrent2 <= lRowMax2
        lCounter = lCounter + 1
        If Worksheets(1).Range("A" & lRowCurrent1) = Worksheets(2).Range("A" & lRowCurrent2) And Worksheets(1).Range("H" & lRowCurrent1) = Worksheets(2).Range("H" & lRowCurrent2) Then
            Worksheets(1).Range("Q" & lRowCurrent1) = Worksheets(2).Range("Q" & lRowCurrent2)
            lRowCurrent2 = lRowCurrent2 + 1
            Exit Do
        End If
        lRowCurrent2 = lRowCurrent2 + 1
        If lRowCurrent2 > lRowMax2 Then
            lRowCurrent2 = 2 'reset to top of sheet if no match was found
        End If
    Loop
Next lRowCurrent1

please note this is the portion that was added.
Code: 
 If lRowCurrent2 > lRowMax2 Then
            lRowCurrent2 = 2 'reset to top of sheet if no match was found
        End If

Because we sort both of the sheets, we don't want to always start from the top of sheet2 for all of the comparisons. That will run slow if you have a lot of records.
If you have a match that is on row 50 of sheet 2, the next item from sheet 1 can't be above that because they are sorted. We only want to start from the top again if we don't find a match.
We could also add another variable for "last row that was copied" and reset the lRowCurrent2 to that variable so we could resume the search from row 50, instead of the top.
 
Great Explanation. I understand what your doing but with the code added we are in endless loop. lRowCurrent2 never becomes greater then lRowMax2 because it is reset by the if statement. To test this simply copy the first row of Report out sheet and make it different. The compare test fails and we never move on from there.
 
Ahh good point,

Code: 
If lRowCurrent2 > lRowMax2 Then 
     lRowCurrent2 = 2 'reset to top of sheet if no match was found 
     exit do
End If

If we go into the if block, lets simply exit the do from there after resetting the variable.
 
Works...Done....Awesome! I have a lot of things I wish I could do with Excel but I simply do not have the knowledge and the programming becomes more time consuming then doing it manually. Would it be OK next time I am stuck or want to automate, if I asked for your help again? You have saved me ???? Two weeks worth of trial and error....Thank you, I REALLY appreciate it.
 
Absolutely I love to help, I used to write data entry programs in a proprietary program that ran off of VBA. It has been over 10 years now that I stopped doing that, but I still seem to program just as much at my current job in Excel making everyone's life in the office easier ;)
Lots of the people on this site are way more knowledgeable than me, but I have learned a lot here by helping answer others questions.
 
:amen: Hope to talk to soon. It is very kind of you to help the way you did.
 
Hello, Simi. I have not spoke to you in a while. The routine you wrote works so well, I have not needed anymore help ....until now. Would you be willing to help me make a change to the search and replace routine you wrote last February for me?. It is simple but I do not want to mess it up? I have embbeded the code to refresh your memory.

Sub simi_report_out()


'lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row


Dim lRowMax1 As Long
Dim lRowMax2 As Long
Dim lRowCurrent1 As Long
Dim lRowCurrent2 As Long
Dim lCounter As Long 'for testing purposes to test itterations


Application.ScreenUpdating = False
lCounter = 0


With Worksheets(1)
'get total row count from sheet 1
lRowMax1 = .Cells(.Rows.Count, "C").End(xlUp).Row

'set values to sort back to original in column R. This loop inserts a numerical count in column "R"
'of the new worksheet so we can return the new sheet back to its origianl sort order.
For lRowCurrent1 = 2 To lRowMax1
.Range("R" & lRowCurrent1) = lRowCurrent1
Next lRowCurrent1

'sort the sheet by column A (Mastec CG) then H (DOM WC ID)
.Range("A2", "R" & lRowMax1).Sort _
Key1:=.Range("A2"), _
Key2:=.Range("H2")
End With


With Worksheets(2)
'get total row count from sheet 1
lRowMax2 = .Cells(.Rows.Count, "C").End(xlUp).Row

'set values to sort back to original in column R
For lRowCurrent2 = 2 To lRowMax1
.Range("R" & lRowCurrent2) = lRowCurrent2
Next lRowCurrent2

'sort the sheet by column A then H
.Range("A2", "R" & lRowMax2).Sort _
Key1:=.Range("A2"), _
Key2:=.Range("H2")
End With


lRowCurrent2 = 2
For lRowCurrent1 = 2 To lRowMax1
Do While lRowCurrent2 <= lRowMax2
lCounter = lCounter + 1
If Worksheets(1).Range("A" & lRowCurrent1) = Worksheets(2).Range("A" & lRowCurrent2) And Worksheets(1).Range("H" & lRowCurrent1) = Worksheets(2).Range("H" & lRowCurrent2) Then
Worksheets(1).Range("Q" & lRowCurrent1) = Worksheets(2).Range("Q" & lRowCurrent2)
lRowCurrent2 = lRowCurrent2 + 1
Exit Do
End If
lRowCurrent2 = lRowCurrent2 + 1

If lRowCurrent2 > lRowMax2 Then
lRowCurrent2 = 2 'reset to top of sheet if no match was found
Exit Do
End If

Loop
Next lRowCurrent1


With Worksheets(1)
'sort the sheet by R to reset to original sorting and delete the data from column R
.Range("A2", "R" & lRowMax1).Sort _
Key1:=.Range("R2")
.Range("R1").EntireColumn.Delete
End With
With Worksheets(2)
'sort the sheet by R to reset to original sorting and delete the data from column R
.Range("A2", "R" & lRowMax2).Sort _
Key1:=.Range("R2")
.Range("R1").EntireColumn.Delete
End With
'MsgBox (lCounter)
Application.ScreenUpdating = True


End Sub


The problem i am having is that in some cases Worksheet (2).Range H overwrites the contents of Worksheet (1).Range H. 99% of the time this is what I want because there is not supposed to be data in Worksheet (1).Range H. But......sometimes there is and I need to test if a test if Worksheet (1).Range H is emtpy and if not "Append" Worksheet (2).Range H data to the cell. Is this very difficult and are you willing to help make this change?

Thank you so much in advance and if not I understand.

Dale
 
I would love to help you with this.

I am not 100% understanding what you need.

Can you upload a file for me to look at, the sample file I had has data in column H (WC ID) for both sheets.
 
I am sorry for the mistake. It is not column "H", It is column "Q" which needs to be tested for existing data. As you know Column "H" is only used to compare rows for equal values...In any event, I have uploaded a new file; "Schedule Simi Test". In this file, Sheet 1: Schd Complete is the target for writing column "Q", and sheet 2: Ron 3_31 is the source for getting Column "Q" data.

Notice on the first row of the target sheet 1, there is an existing comment "duct collapsed" . This comment cannot be over written by the previous week comment of sheet 2, 45% complete: instead the old comment 45% should be appended to the bottom of the sheet 1 target cell.

I hope I have made this clear, please let me know and as always. THANK YOU!
 

Attachments

  • Schedule Simi test.xlsm
    474.7 KB · Views: 15
Last edited:
Ok column "Q" makes much more sense to me now.

This is actually very simple to accomplish. Just add the portion in red to your existing line of code.
This will keep the data in sheet1 then the Chr(10) is a line feed, so the data from sheet2 will appear below the original data.

Worksheets(1).Range("Q" & lRowCurrent1) = Worksheets(1).Range("Q" & lRowCurrent1) & Chr(10) & Worksheets(2).Range("Q" & lRowCurrent2)

You can also add an if statement around this code to check if the sheet1 cell is blank or not. Which is a good idea so you don't get all your data with a line feed before it.

Code: 
If Worksheets(1).Range("Q" & lRowCurrent1) = "" Then
     Worksheets(1).Range("Q" & lRowCurrent1) = Worksheets(2).Range("Q" & lRowCurrent2)
Else
     Worksheets(1).Range("Q" & lRowCurrent1) = Worksheets(1).Range("Q" & lRowCurrent1) & Chr(10) & Worksheets(2).Range("Q" & lRowCurrent2)
End If
 
Last edited:
Works Great! So simple. I understand what you have but only after the code is written. My code is crude plug and play and takes me a ton of trial and error. I wish I could program at your level. Are you for hire by any chance? I have a lot of improvements I could make and a lot questions. You could help me so much.

Dale
 
No i'm not for hire, but just keep posting questions here and I or others will help.
Trial and error is how I learn. I have learned a lot from others from this site, it is a wonderful community of people.
 
You must log in or register to reply here.
Back
Top