Change specific values (not all) in a VBA sub

juscuz419

Board Regular
Joined
Apr 18, 2023
Messages
57
Office Version
  1. 2019
Platform
  1. Windows
I am trying really hard to teach myself VBA through trial and error. I have the following that is doing exactly what I want it to do. And I'm sure there is a much better and more elegant way to do it, but it does work.
What I cannot figure out is how to change move to the next row of both the source and target worksheets for the cells shown below in bold red font. This is the first of probably many things I ultimately want this sub to do so any help will be another learning tool for me.

Sub CopyValuesBetweenWorksheets()
Dim sourceWS As Worksheet
Dim targetWS As Worksheet

' Set the source and target worksheets
Set sourceWS = ThisWorkbook.Worksheets("MRC_4699A") ' eventually replace "MRC_4699A" with the next sheet with a name LIKE {"***_*****}
Set targetWS = ThisWorkbook.Worksheets("Daily Summary") '
' Copy values from specific cells in the source sheet
targetWS.Range("B21").Value = sourceWS.Range("f4").Value
targetWS.Range("c21").Value = sourceWS.Range("m4").Value
targetWS.Range("d21").Value = sourceWS.Range("q1").Value
targetWS.Range("f21").Value = sourceWS.Range("e18").Value
targetWS.Range("g21").Value = sourceWS.Range("f18").Value
targetWS.Range("h21").Value = sourceWS.Range("g18").Value
targetWS.Range("i21").Value = sourceWS.Range("h18").Value
targetWS.Range("E21").Value = ""
If sourceWS.Range("AB3").Value Or sourceWS.Range("AB4").Value = True Then
targetWS.Range("E21").Value = "Pickup/SUV"
End If

Dim nonBlankCount1 As Long
nonBlankCount1 = Application.WorksheetFunction.Count(sourceWS.Range("K18:M18"))
targetWS.Range("k21") = nonBlankCount1

Dim nonBlankCount2 As Long
nonBlankCount2 = Application.WorksheetFunction.Count(sourceWS.Range("N18"))
targetWS.Range("L21") = nonBlankCount2
If nonBlankCount2 = 1 Then
targetWS.Range("L21") = "yes"
End If

End Sub
 
Re: the code from post 8
without knowing what's not working can't help you.

When the procedure stopped at the STOP instruction and you then proceeded one line at a time using the F8 key
did any sheets satisfy the LIKE statement ?
 
Upvote 0

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
The coded walked through all the ws in the wb and for each loop it made the source ws name the name of the sheet in that loop. only two of the sheets 5 sheets satisfy the pattern though
 
Upvote 0
Basically I am pulling info for up to three rows on each timesheet and pasting them into a summary sheet, then going to the next timesheet and getting up to three rows and pasting them into the next rows on the summary and so on until I have gone through ALL the time sheets.
It would be helpful to have all of the information up front. How does the following code work for you?
VBA Code:
Sub CopyValuesBetweenWorksheets()
    Const cstrTitle As String = "Copy Values"
    Const cstrLike As String = "[A-Z][A-Z][A-Z]_[0-9][0-9][0-9][0-9]"
    Dim sourceWS As Worksheet
    Dim targetWS As Worksheet
    Dim loopWS As Worksheet
    Dim lngRow As Long
    Dim lngCol As Long
    Dim rngCell As Range
    Dim bolFmtOK As Boolean
    Dim lngPasteRow As Long
    '
    ' Set the target worksheet
    Set targetWS = ThisWorkbook.Worksheets("Daily Summary")
    lngPasteRow = 21
    ' Loop through the source worksheets
    For Each loopWS In ThisWorkbook.Worksheets
        bolFmtOK = False
        If (Left(UCase(loopWS.Name), 8) Like cstrLike) Then
            Select Case UCase(Mid(loopWS.Name, 9))
                Case "A", "D", "WG"
                    bolFmtOK = True
            End Select
        End If
        If bolFmtOK Then
            Set sourceWS = loopWS
            ' PUT YOUR PROCESSING CODE HERE
            With targetWS
                ' Copy values from specific cells in the source sheet
                targetWS.Range("B" & lngPasteRow).Value = sourceWS.Range("f4").Value
                targetWS.Range("c" & lngPasteRow).Value = sourceWS.Range("m4").Value
                targetWS.Range("d" & lngPasteRow).Value = sourceWS.Range("q1").Value
                '
                lngRow = 0
                For lngCol = 0 To 3 ' f21 to i21, e18 to h18
                    .Range("f" & lngPasteRow).Offset(lngRow, lngCol).Value = sourceWS.Range("e18").Offset(lngRow, lngCol).Value
                Next
                '
                Set rngCell = .Range("E" & lngPasteRow)
                If (sourceWS.Range("AB3").Value Or sourceWS.Range("AB4").Value) Then
                    rngCell.Value = "Pickup/SUV"
                Else
                    rngCell.ClearContents
                End If
                '
                .Range("K" & lngPasteRow).Value = Application.WorksheetFunction.Count(sourceWS.Range("K18:M18"))
                '
                Set rngCell = .Range("L" & lngPasteRow)
                rngCell.Value = Application.WorksheetFunction.Count(sourceWS.Range("N18"))
                If (rngCell.Value = 1) Then
                    rngCell.Value = "yes"
                End If
                lngPasteRow = lngPasteRow + 4
            End With
        End If
    Next loopWS
End Sub
 
Upvote 0
This gets the data for only one row of source sheet of the when there are three, skips three rows on the summary and gets the same thing for the next source sheet. I think I am really close on a solution for all of this. I thank you for all of your suggestions. I have learned a great deal from just walking through you code and figuring out what you were doing. Thanks.
 
Upvote 0
There is no solution in this thread.
You should at least give credit to DanteAmor for solving this in the other thread
and unmark your own posts as being solutions.
 
Upvote 0
My apologies to the forum members. Not a frequent poster and did not know all of the rules. I have found and read them. I'll do better in future posts.
 
Upvote 0

Forum statistics

Threads
1,223,898
Messages
6,175,272
Members
452,628
Latest member
dd2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top