Combine two routines

[bdt]

Hi all,
I have a code where I take a range of cells in a column and place them in another sheet in a row, which works fine. In my ignorance I thought I could have another similar piece of code that takes a different range of cells and puts then in the same row as the first piece of code. I didn't appreciate the second code overwrites the first. Is it possible to combine the two codes so that range AI21:AI33 and BM21:BM33 are placed in the same cells in a row on the sheet "OVERTIME". My code is;

'add overtime sunday
With ActiveSheet
WKend = .Range("M2").Value
arr = .Range("AI21:AI33").Value
End With

With Sheets("OVERTIME").Range("A:A")
Set fndRng = .Find(What:=Format(WKend, "dd/mm/yy"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not fndRng Is Nothing Then
fndRng.Offset(, 1).Resize(, UBound(arr)).Value = Application.Transpose(arr)
Else
MsgBox "Sorry, did not find " & WKend
End If

End With

'add absence sunday
With ActiveSheet
WKend = .Range("M2").Value
arr = .Range("BM21:BM33").Value
End With

With Sheets("OVERTIME").Range("A:A")
Set fndRng = .Find(What:=Format(WKend, "dd/mm/yy"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not fndRng Is Nothing Then
fndRng.Offset(, 1).Resize(, UBound(arr)).Value = Application.Transpose(arr)
Else
MsgBox "Sorry, did not find " & WKend
End If
End With

Many thanks again

 

[bdt]

Hi,
NoSparks, your code did exactly as you said. I have attached a photo of the results I'm after. aar1 adds the numbers to the row. arr2 updates that row with an "A" from Range(BM21:BM) overwriting any exsisting number in that cell, but leaves all other cells in the row alone.
Hope this clarifies.

 

[NoSparks]

you say

aar1 adds the numbers to the row. arr2 updates that row with an "A" from Range(BM21:BM) overwriting any exsisting number in that cell,

but your picture shows zero and A in row 40 G,H and I
which one would you like ?

edit
and what is actually in Range("AI21:AI33") and Range("BM21:BM33")

 

[bdt]

I would like arr2 to add a "A", the zeros are a result of nothing being in the range for arr1
Thanks

 

[bdt]

Range("AI21:AI33") are numbers and Range("BM21:BM33") is the letter A

 

[NoSparks]

Okay, change this part of post 10

        For Each cel In rng2
            fndRng.Offset(, i) = fndRng.Offset(, i).Value & Chr(10) & cel.Value
            i = i + 1
        Next cel

to

        For Each cel In rng2
            If cel.Value = "A" Then fndRng.Offset(, i) = cel.Value
            i = i + 1
        Next cel

 

[bdt]

NoSparks, once again you've come to my rescue. Many thanks for your patience

 

[NoSparks]

Glad we got it sorted.
Now for your other thread.....

 

[bdt]

no rush but would be grateful

 

[bdt]

Guys, back again!
The original question was resolved, but as I'm still trying to develope my spreadsheet further I have found that I need the same senario, but to add the two ranges arr1 and arr2 to the next new row in sheet "OVERTIME" where the date currently does not exsist instead of the originally designed one range Range("AI21:AI32"). Saturday has only the one range.
I have the following code, which I've had a go at modifying by adding the extra arr2, but unfortunately arr2 is overwriting arr1. Any help much appreciated.

Public Sub CopySheetAndRenamePredefined()
     
     Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim response As String
    For Each ws In Sheets
        If ws.Range("B2") <> "" And ws.Range("C2") = "" Then
        Do
            response = InputBox("Input date in format **/**/**")
            If response <> "" Then
            ws.Range("C2") = response
            Exit Do
            ElseIf response = "" Then
            MsgBox ("You must enter date in format **/**/**")

        Else: Exit Do
        End If
    Loop
    
    End If
    Next ws
    Application.ScreenUpdating = True
    
    Dim WKend
    Dim arr As Variant
    Dim writerow As Long

    
     'copy overtime and absence sunday
     With Sheets("ABACUS")
     WKend = .Range("M2").Value2
     arr1 = .Range("AI21:AI32").Value
     arr2 = .Range("CY21:CY32").Value
     End With

     With Sheets("OVERTIME")
     ' last used row in column B plus 1
    
     writerow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    .Range("A2") = Format(Date, "dd/mm/yy")
    .Range("A" & writerow) = WKend
    .Range("B" & writerow).Resize(, UBound(arr1)).Value = Application.Transpose(arr1)
    .Range("B" & writerow).Resize(, UBound(arr2)).Value = Application.Transpose(arr2)
     End With
   
   
    'copy overtime and absence monday
    With Sheets("ABACUS")
    WKend = .Range("AC2").Value2
    arr1 = .Range("AK21:AK32").Value
    arr2 = .Range("DA21:DA32").Value
    End With

    With Sheets("OVERTIME")
    ' last used row in column B plus 1
    writerow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
    .Range("A" & writerow) = WKend
    .Range("B" & writerow).Resize(, UBound(arr1)).Value = Application.Transpose(arr1)
    .Range("B" & writerow).Resize(, UBound(arr2)).Value = Application.Transpose(arr2)
    End With

    'copy overtime and absence tuesday
    With Sheets("ABACUS")
    WKend = .Range("AS2").Value2
    arr1 = .Range("AM21:AM32").Value
    arr2 = .Range("DC21:DC32").Value
    End With

    With Sheets("OVERTIME")
    ' last used row in column B plus 1
    writerow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
    .Range("A" & writerow) = WKend
    .Range("B" & writerow).Resize(, UBound(arr1)).Value = Application.Transpose(arr1)
    .Range("B" & writerow).Resize(, UBound(arr2)).Value = Application.Transpose(arr2)
    End With

    'copy overtime and abence wednesday
    With Sheets("ABACUS")
    WKend = .Range("BI2").Value2
    arr1 = .Range("AO21:AO32").Value
    arr2 = .Range("DE21:DE32").Value
    End With

    With Sheets("OVERTIME")
    ' last used row in column B plus 1
    writerow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
    .Range("A" & writerow) = WKend
    .Range("B" & writerow).Resize(, UBound(arr1)).Value = Application.Transpose(arr1)
    .Range("B" & writerow).Resize(, UBound(arr2)).Value = Application.Transpose(arr2)
    End With

    'copy overtime and absence thursday
    With Sheets("ABACUS")
    WKend = .Range("BY2").Value2
    arr1 = .Range("AQ21:AQ32").Value
    arr2 = .Range("DG21:DG32").Value
    End With

    With Sheets("OVERTIME")
    ' last used row in column B plus 1
    writerow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
    .Range("A" & writerow) = WKend
    .Range("B" & writerow).Resize(, UBound(arr1)).Value = Application.Transpose(arr1)
    .Range("B" & writerow).Resize(, UBound(arr2)).Value = Application.Transpose(arr2)
    End With

    'copy overtime and absence friday
    With Sheets("ABACUS")
    WKend = .Range("CO2").Value2
    arr1 = .Range("AS21:AS32").Value
    arr2 = .Range("DI21:DI32").Value
    End With

    With Sheets("OVERTIME")
    ' last used row in column B plus 1
     writerow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
    .Range("A" & writerow) = WKend
    .Range("B" & writerow).Resize(, UBound(arr1)).Value = Application.Transpose(arr1)
    .Range("B" & writerow).Resize(, UBound(arr2)).Value = Application.Transpose(arr2)
    End With

 'copy overtime saturday
    With Sheets("ABACUS")
        WKend = .Range("DE2").Value2
        arr = .Range("AU21:AU32").Value
    End With

    With Sheets("OVERTIME")
    ' last used row in column B plus 1
    writerow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
    .Range("A" & writerow) = WKend
    .Range("B" & writerow).Resize(, UBound(arr)).Value = Application.Transpose(arr)
    .Range("A" & writerow & ":X" & writerow).Borders(xlEdgeBottom).LineStyle = xlContinuous
    End With
   
      
    
    ActiveSheet.Copy After:=Worksheets("OVERTIME")
    ActiveSheet.Name = "W.E." & Format(Range("C2").Value, "dd.mm.yy")
    ActiveSheet.Shapes("Button 1").Delete
        
 
    ActiveSheet.Buttons.add(75, 150, 150, 100).Select
    With Selection
    .Name = "New Button"
    .OnAction = "Button3_Click"
    .Text = "SAVE CHANGES"
    .Font.Size = 24
    .Font.Bold = True
    ActiveSheet.Range("D5").Select
    End With
  
  
    Worksheets("ABACUS").Activate
    Range("D5:DK17").ClearContents
    Range("CY22:DJ32").ClearContents
    Range("C2").ClearContents
    Range("BP22:CE33").ClearContents
    Range("E3,G3,I3,K3,M3,O3,Q3,S3,U3,W3,Y3,AA3,AC3,AE3,AG3,AI3,AK3,AM3,AO3,AQ3,AS3,AU3,AW3,AY3,BA3,BC3,BE3,BG3,BI3,BK3,BM3,BO3").ClearContents
    Range("BQ3,BS3,BU3,BW3,BY3,CA3,CC3,CE3,CG3,CI3,CK3,CM3,CO3,CQ3,CS3,CU3,CW3,CY3,DA3,DC3,DE3,DG3,DI3,DK3").ClearContents
    [B25] = Range("DM2").Value
    [B26] = Range("DM2").Value
    [B27] = Range("DM2").Value
    [B28] = Range("DM2").Value
    [B29] = Range("DM2").Value
    [B30] = Range("DM2").Value
    [B31] = Range("DM2").Value
    [B32] = Range("DM2").Value
    
     End Sub

PS. hoping this additional post is acceptable to the moderators

 

[bdt]

for clarification, arr1 and arr2 have to combine to go into the same row and same columns in "OVERTIME", where arr1 is a number and arr2 is the letter "A".
I have the code below, which does combine the two ranges, but into an existing row in "OVERTIME". With my very limited knowledge of VBA I have no idea how to make this work for my code posted a few minutes ago.

Sub Button3_Click()

    
    Dim WKend As Date
    Dim rng1 As Range, rng2 As Range
    Dim fndRng As Range, cel As Range
    Dim i As Long
    
'add overtime and absence sunday
With ActiveSheet
    WKend = .Range("M2").Value
    Set rng1 = .Range("AI21:AI32")
    Set rng2 = .Range("CY21:CY32")
End With

With Sheets("OVERTIME").Range("A:A")
    ' find date
    Set fndRng = .Find(What:=Format(WKend, "dd/mm/yy"), _
                        LookIn:=xlValues, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)

    If Not fndRng Is Nothing Then   'if found
        i = 1
        For Each cel In rng1
            fndRng.Offset(, i) = cel.Value
            i = i + 1
        Next cel
        i = 1
        For Each cel In rng2
            If cel.Value = "A" Then fndRng.Offset(, i) = cel.Value
            i = i + 1
        Next cel
    Else                            'if not found
        MsgBox "Sorry, did not find " & WKend
    End If
End With


'add overtime and absence monday
With ActiveSheet
    WKend = .Range("AC2").Value
    Set rng1 = .Range("AK21:AK32")
    Set rng2 = .Range("DA21:DA32")
End With

With Sheets("OVERTIME").Range("A:A")
    ' find date
    Set fndRng = .Find(What:=Format(WKend, "dd/mm/yy"), _
                        LookIn:=xlValues, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)

    If Not fndRng Is Nothing Then   'if found
        i = 1
        For Each cel In rng1
            fndRng.Offset(, i) = cel.Value
            i = i + 1
        Next cel
        i = 1
        For Each cel In rng2
            If cel.Value = "A" Then fndRng.Offset(, i) = cel.Value
            i = i + 1
        Next cel
    Else                            'if not found
        MsgBox "Sorry, did not find " & WKend
    End If
End With


'add overtime and absence tuesday
With ActiveSheet
    WKend = .Range("AS2").Value
    Set rng1 = .Range("AM21:AM32")
    Set rng2 = .Range("DC21:DC32")
End With

With Sheets("OVERTIME").Range("A:A")
    ' find date
    Set fndRng = .Find(What:=Format(WKend, "dd/mm/yy"), _
                        LookIn:=xlValues, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)

    If Not fndRng Is Nothing Then   'if found
        i = 1
        For Each cel In rng1
            fndRng.Offset(, i) = cel.Value
            i = i + 1
        Next cel
        i = 1
        For Each cel In rng2
            If cel.Value = "A" Then fndRng.Offset(, i) = cel.Value
            i = i + 1
        Next cel
    Else                            'if not found
        MsgBox "Sorry, did not find " & WKend
    End If
End With


'add overtime and absence wednesday
With ActiveSheet
    WKend = .Range("BI2").Value
    Set rng1 = .Range("AO21:AO32")
    Set rng2 = .Range("DE21:DE32")
End With

With Sheets("OVERTIME").Range("A:A")
    ' find date
    Set fndRng = .Find(What:=Format(WKend, "dd/mm/yy"), _
                        LookIn:=xlValues, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)

    If Not fndRng Is Nothing Then   'if found
        i = 1
        For Each cel In rng1
            fndRng.Offset(, i) = cel.Value
            i = i + 1
        Next cel
        i = 1
        For Each cel In rng2
            If cel.Value = "A" Then fndRng.Offset(, i) = cel.Value
            i = i + 1
        Next cel
    Else                            'if not found
        MsgBox "Sorry, did not find " & WKend
    End If
End With


'add overtime and absence thursday
With ActiveSheet
    WKend = .Range("BY2").Value
    Set rng1 = .Range("AQ21:AQ32")
    Set rng2 = .Range("DG21:DG32")
End With

With Sheets("OVERTIME").Range("A:A")
    ' find date
    Set fndRng = .Find(What:=Format(WKend, "dd/mm/yy"), _
                        LookIn:=xlValues, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)

    If Not fndRng Is Nothing Then   'if found
        i = 1
        For Each cel In rng1
            fndRng.Offset(, i) = cel.Value
            i = i + 1
        Next cel
        i = 1
        For Each cel In rng2
            If cel.Value = "A" Then fndRng.Offset(, i) = cel.Value
            i = i + 1
        Next cel
    Else                            'if not found
        MsgBox "Sorry, did not find " & WKend
    End If
End With


'add overtime and absence friday
With ActiveSheet
    WKend = .Range("CO2").Value
    Set rng1 = .Range("AS21:AS32")
    Set rng2 = .Range("DI21:DI32")
End With

With Sheets("OVERTIME").Range("A:A")
    ' find date
    Set fndRng = .Find(What:=Format(WKend, "dd/mm/yy"), _
                        LookIn:=xlValues, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)

    If Not fndRng Is Nothing Then   'if found
        i = 1
        For Each cel In rng1
            fndRng.Offset(, i) = cel.Value
            i = i + 1
        Next cel
        i = 1
        For Each cel In rng2
            If cel.Value = "A" Then fndRng.Offset(, i) = cel.Value
            i = i + 1
        Next cel
    Else                            'if not found
        MsgBox "Sorry, did not find " & WKend
    End If
End With


     'add overtime saturday no absence
    With ActiveSheet
    WKend = .Range("DE2").Value
    arr = .Range("AU21:AU32").Value
End With

With Sheets("OVERTIME").Range("A:A")
    Set fndRng = .Find(What:=Format(WKend, "dd/mm/yy"), _
                       LookIn:=xlValues, _
                       LookAt:=xlPart, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlNext, _
                       MatchCase:=False)
                       
    If Not fndRng Is Nothing Then
        fndRng.Offset(, 1).Resize(, UBound(arr)).Value = Application.Transpose(arr)
    Else
        MsgBox "Sorry, did not find " & WKend
    End If
End With


End Sub