VBA: Where to paste a copied cell based on two criteria

LWell

New Member
Joined
Jun 1, 2015
Messages
20
Hello,

I am working on a project in a workbook with two sheets. One sheet (Sheet1) comes directly from an external program and I am trying to clean it up on the second sheet (Sheet2).

Sheet1 column B has a list of hundreds of account numbers in "****-***-**" where * is always an integer or a letter. However, they do not occur every line, at equal intervals, or without reoccurrence

I have already used a macro to sort through this column B and place every unique account number in column A of Sheet2 starting in row 6. It is:

Code:
Sub Add_Account_Numbers()
  Dim lRowCount&


  lRowCount = Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
  
  With Sheets("Sheet2").Range("A6").Resize(lRowCount)
    .Formula = "=IF(MID('Sheet1'!B1,5,1)=""-"",MID('Sheet1'!B1,1,11),"""")"
    .Value = .Value
    .Columns("A").Sort key1:=Range("A6"), _
       order1:=xlAscending
  End With
  
  Range("A6", Range("A20000").End(xlUp)).NumberFormat = "General"
  
  ActiveSheet.Range("A6:A20000").RemoveDuplicates Columns:=Array(1), Header:=xlYes

End Sub

In Sheet2 I also have columns for January-December

Now for where I'm stuck. ColumnI of Sheet1 contains intermittent text that reads "PERIOD XX ACTIVITY" where "XX" is 01-12. Where 01 is January, 02 in February, etc. The value that I want to get off of Sheet1 and into Sheet2 is always four cells to the right of the "PERIOD XX ACTIVITY" cell (therefore it is always in column M). Thus I have used the following to copy the cell that I want. I have one for each of the 12 months.

Code:
Sub Add_Account_Values()  Dim Rng As Range, rCell As Range
    
    Worksheets("Sheet1").Activate
    Set Rng = Range("I1:I20000")
    
        For Each rCell In Rng.Cells
    
        If rCell.Value = "PERIOD 01 ACTIVITY" Then
            rCell.Select
            ActiveCell.Offset(, 4).Copy
        Exit For
        End If
        Next rCell
End Sub

What I don't know is to tell it where or how to paste. Basically, it needs to paste on Sheet2 in the cell that is the intersection of the column (month) and row (account number) that it is associated with.

To find the column in Sheet2 it needs to go in: go four cells to the left of the copied cell. If "PERIOD 01 ACTIVITY", put in January column. If "PERIOD 02 ACTIVITY", put in February column, etc.

To find the row in Sheet2 it needs to go in: go up from copied cell until a blank cell is selected. Then go back to column B in that row and go down EITHER one or NO cells. If there is a "Beginning of Year" balance for that account, go down one cell in column B. Here is an example of this. If there is no "Beginning of Year" balance for that account, go down no cells in column B. Here is an example of this. If "0000-000-01", put in row with "0000-000-01" in column A in Sheet2. If "0000-000-02", put in row with "0000-000-02" in column A in Sheet2.

I realize this is terribly confusing so I've linked to screenshots of a dumbest down version of what I'm dealing with. I've kept all the rows and columns the same but left out all of the superfluous data.

Thank you so much for any help! Please let me know what needs more clarification.

Best,
 
Last edited:

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
I am not getting a vision of what the sheets look like. Can you post a screen shot of the sheets? or a mock up illustration? or a link to a share server where the sheets can be seen?
 
Upvote 0
This assumes you will have a list of account numbers on sheet 2 beginning in row 6. Hopefully, they will match the numbers on sheet 1, unlike the example in the link which almost drove me nuts.
Code:
Sub summary()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, act As String, rw As Long, rng As Range, col As Long, no As String, mo As String
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
  ActiveSheet.Range("A6:A20000").RemoveDuplicates Columns:=Array(1), Header:=xlYes
Set rng = sh2.Range("A6", sh2.Cells(Rows.Count, 1).End(xlUp))
    For Each c In sh1.Range("I6", sh1.Cells(Rows.Count, 9).End(xlUp))
        If Left(c.Value, 6) = "PERIOD" Then
            no = Mid(c.Value, 8, 2)
            Select Case no
                Case "01"
                    mo = "January"
                Case "02"
                    mo = "February"
                Case "03"
                    mo = "March"
                Case "04"
                    mo = "April"
                Case "05"
                    mo = "May"
                Case "06"
                    mo = "June"
                Case "07"
                    mo = "July"
                Case "08"
                    mo = "August"
                Case "09"
                    mo = "September"
                Case "10"
                    mo = "Octomber"
                Case "11"
                    mo = "November"
                Case "12"
                    mo = "December"
            End Select
            act = c.Offset(0, -7).End(xlUp).Offset(-1, 0).Value
            rw = rng.Find(act, , xlValues, xlWhole).Row
            col = sh2.Rows(5).Find(mo, , xlValues, xlWhole).Column
            sh2.Range("B" & rw) = c.Offset(0, -8).End(xlUp).Value
            sh2.Cells(rw, col) = c.Offset(0, 4).Value
        End If
    Next
End Sub
 
Upvote 0
This version might save a little time. It also eliminates an erroneous line of code from the previous version.
Code:
Sub summary2()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, act As String, rw As Long, rng As Range, col As Long, no As String, mo As String
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
Set rng = sh2.Range("A6", sh2.Cells(Rows.Count, 1).End(xlUp))
    For Each c In sh1.Range("I6", sh1.Cells(Rows.Count, 9).End(xlUp))
                If Left(c.Value, 6) = "PERIOD" Then
            no = Mid(c.Value, 8, 2)
            Select Case no
                Case "01"
                    mo = "January"
                Case "02"
                    mo = "February"
                Case "03"
                    mo = "March"
                Case "04"
                    mo = "April"
                Case "05"
                    mo = "May"
                Case "06"
                    mo = "June"
                Case "07"
                    mo = "July"
                Case "08"
                    mo = "August"
                Case "09"
                    mo = "September"
                Case "10"
                    mo = "Octomber"
                Case "11"
                    mo = "November"
                Case "12"
                    mo = "December"
            End Select
            act = c.Offset(0, -7).End(xlUp).Offset(-1, 0).Value
            rw = rng.Find(act, , xlValues, xlWhole).Row
            col = sh2.Rows(5).Find(mo, , xlValues, xlWhole).Column
                If sh2.Range("B" & rw) = "" Then
                    sh2.Range("B" & rw) = c.Offset(0, -8).End(xlUp).Value
                End If
            sh2.Cells(rw, col) = c.Offset(0, 4).Value
        End If
    Next
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

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