Go to sheet based on cell refference and copy/transpose values in a different sheet

M

MEP1984

New Member
Joined
Sep 29, 2015
Messages
10
Hi, all,
I have the following problem
I have a file, in which a new sheet is added every month with new information. My aim is to create a macro on a ceparate worksheet((named Macro) in this file, that goes into the sheet for the respective month, based on cell refference. For ex, if A2 = Jan16, go to sheet Jan16. Then it should filter the values that are not equal (for ex- the movement of the prices of articles through the year plus the current month). For that purpose I have added a new column in each sheet, comparing the values, so the Macro should go to this column (AO, refresh and filter the "false"(If the price is the same- no action. If not- copy the range of materials- visible cells only in cell range A4-T4 (and right untill we have values as each month there will be a new column) untill the bottom where we have values, and paste special in sheet Macro, values, transpose (the months to be vertical, the article numbers- horisontal.)
I have read a lot and tried to create a VBA code - simple macro copying my actions. But I receive an error message. The code works well when I simply go into a sheet and copy paste special the values. But when I try to update the code with refference to the cell A2, the macro doesnt work, and I receive an error message for the copy paste special/transpose part, not for the part of the cell refference.
Could you please advise what i should do? If additional information is needed- just let me know.
Thanks to all!
 
Sort by date Sort by votes
RCBricker said:
I fixed your comparison formula so it is more dynamic to the data set. so try this code instead

Rich (BB code): 
Sub mep1984()
Dim wsM As Worksheet, ws As Worksheet
Dim lngrow As Long, lngcol As Long, lngrowst As Long
Dim rnghead As Range, rng As Range, cell As Range
Dim intCOL As Integer, intMTH1 As Integer, intMTH2 As Integer, _
    intST As Integer, intEND As Integer
Dim strMTH As String
    strMTH = "Comparison" 'Change this to the formula header name
    lngrowst = 4
    Set wsM = Sheets("MEP1984 - macro") 'change this to Macro
    With wsM
        strMTH = wsM.Range("A2")
        If strMTH = "" Then
            MsgBox "Please enter a value into cell A2 to represent the " _
                        & "month year (ie: Nov16)." _
                        & vbNewLine & "Then start again."
            End
        End If
        lngrow = wsM.Range("A" & wsM.Rows.Count).End(xlUp).Row
        If Not lngrow = lngrowst - 2 Then
        
            lngcol = wsM.Cells(4, wsM.Columns.Count).End(xlToLeft).Column
            
            Set rng = wsM.Range(wsM.Cells(lngrowst, 1), wsM.Cells(lngrow, lngcol))
            rng.Delete shift:=xlUp
        End If
    End With
    
    Set ws = Sheets(strMTH)
    ws.Select
    With ws
        lngrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        lngcol = ws.Cells(4, ws.Columns.Count).End(xlToLeft).Column
        intCOL = lngcol + 1
        ws.Cells(lngrowst, intCOL).Value = "Comparison" 'change to new field header
        Set rnghead = ws.Range(ws.Cells(lngrowst, 1), ws.Cells(lngrowst, intCOL))
        intMTH2 = lngcol
        intMTH1 = rnghead.Find("Jan").Column    'Change this to the header of the first column to be compared by the formula
        Set rng = ws.Range(ws.Cells(lngrowst + 2, intCOL), _
            ws.Cells(lngrow, intCOL))
        intST = intMTH1 - intCOL
        intEND = intMTH2 - intCOL
        rng.Formula = "=IF(SUM(IF(FREQUENCY(RC[" & intST & "]:RC[" _
                        & intEND & "],RC[" & intST & "]:RC[" & intEND _
                        & "])>0,1))>1,""False"","""")"
        rng.Copy
        rng.PasteSpecial xlPasteValues
        
        Set rng = ws.Range(ws.Cells(lngrowst, 1), ws.Cells(lngrow, lngcol))
        .AutoFilterMode = False
        rnghead.AutoFilter field:=intCOL, Criteria1:="False"
        rng.SpecialCells(xlCellTypeVisible).Copy
        wsM.Range("A4").PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=True, _
            Transpose:=True
    End With
    wsM.Select
End Sub
Click to expand...

Hi, Thanks a lot! Didnt have access to check it earlier, but I receive an error in the bold line (I have changed the names as you have advised me in green). I think the problem might be that the name of the colun to compare is a date. I tried with 01/08/2016 and it didnt work. I tried with Aug-16, also doesnt work. Could you please advise on that?

Rich (BB code): 
Sub macro()
Dim wsM As Worksheet, ws As Worksheet
Dim lngrow As Long, lngcol As Long, lngrowst As Long
Dim rnghead As Range, rng As Range, cell As Range
Dim intCOL As Integer, intMTH1 As Integer, intMTH2 As Integer, _
    intST As Integer, intEND As Integer
Dim strMTH As String
    strMTH = "True or false" 'Change this to the formula header name
    lngrowst = 4
    Set wsM = Sheets("Macro") 'change this to Macro
    With wsM
        strMTH = wsM.Range("A2")
        If strMTH = "" Then
            MsgBox "Please enter a value into cell A2 to represent the " _
                        & "month year (ie: Nov16)." _
                        & vbNewLine & "Then start again."
            End
        End If
        lngrow = wsM.Range("A" & wsM.Rows.Count).End(xlUp).Row
        If Not lngrow = lngrowst - 2 Then
        
            lngcol = wsM.Cells(4, wsM.Columns.Count).End(xlToLeft).Column
            
            Set rng = wsM.Range(wsM.Cells(lngrowst, 1), wsM.Cells(lngrow, lngcol))
            rng.Delete shift:=xlUp
        End If
    End With
    
    Set ws = Sheets(strMTH)
    ws.Select
    With ws
        lngrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        lngcol = ws.Cells(4, ws.Columns.Count).End(xlToLeft).Column
        intCOL = lngcol + 1
        ws.Cells(lngrowst, intCOL).Value = "True or false" 'change to new field header
        Set rnghead = ws.Range(ws.Cells(lngrowst, 1), ws.Cells(lngrowst, intCOL))
        intMTH2 = lngcol
        intMTH1 = rnghead.Find("Aug-16").Column    'Change this to the header of the first column to be compared by the formula
        Set rng = ws.Range(ws.Cells(lngrowst + 2, intCOL), _
            ws.Cells(lngrow, intCOL))
        intST = intMTH1 - intCOL
        intEND = intMTH2 - intCOL
        rng.Formula = "=IF(SUM(IF(FREQUENCY(RC[" & intST & "]:RC[" _
                        & intEND & "],RC[" & intST & "]:RC[" & intEND _
                        & "])>0,1))>1,""False"","""")"
        rng.Copy
        rng.PasteSpecial xlPasteValues
        
        Set rng = ws.Range(ws.Cells(lngrowst, 1), ws.Cells(lngrow, lngcol))
        .AutoFilterMode = False
        rnghead.AutoFilter field:=intCOL, Criteria1:="False"
        rng.SpecialCells(xlCellTypeVisible).Copy
        wsM.Range("A4").PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=True, _
            Transpose:=True
    End With
    wsM.Select
End Sub
 
Last edited:
Upvote 0

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
quick question.

Why would you change that find to look for AUG-16? That find is to locate the column of the first month in the formula area for comparison? So January would be my guess.

this will fix the issue for finding a date.

Code: 
Sub mep1984()
Dim wsM As Worksheet, ws As Worksheet
Dim lngrow As Long, lngcol As Long, lngrowst As Long
Dim rnghead As Range, rng As Range, cell As Range
Dim intCOL As Integer, intMTH1 As Integer, intMTH2 As Integer, _
    intST As Integer, intEND As Integer
Dim strMTH As String
    strMTH = "Comparison" 'Change this to the formula header name
    lngrowst = 4
    Set wsM = Sheets("MEP1984 - macro") 'change this to Macro
    With wsM
        strMTH = wsM.Range("A2")
        If strMTH = "" Then
            MsgBox "Please enter a value into cell A2 to represent the " _
                        & "month year (ie: Nov16)." _
                        & vbNewLine & "Then start again."
            End
        End If
        lngrow = wsM.Range("A" & wsM.Rows.Count).End(xlUp).Row
        If Not lngrow = lngrowst - 2 Then
        
            lngcol = wsM.Cells(4, wsM.Columns.Count).End(xlToLeft).Column
            
            Set rng = wsM.Range(wsM.Cells(lngrowst, 1), wsM.Cells(lngrow, lngcol))
            rng.Delete Shift:=xlUp
        End If
    End With

    Set ws = Sheets(strMTH)
    ws.Select
    With ws
        strMTH = Format("01/01/2016", "Short Date")     'Change this to the header of the first column to be compared by the formula
        lngrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        lngcol = ws.Cells(4, ws.Columns.Count).End(xlToLeft).Column
        intCOL = lngcol + 1
        ws.Cells(lngrowst, intCOL).Value = "Comparison" 'change to new field header
        Set rnghead = ws.Range(ws.Cells(lngrowst, 1), ws.Cells(lngrowst, intCOL))
        intMTH2 = lngcol
        intMTH1 = rnghead.Find(CDate(strMTH)).Column
        Set rng = ws.Range(ws.Cells(lngrowst + 2, intCOL), _
            ws.Cells(lngrow, intCOL))
        intST = intMTH1 - intCOL
        intEND = intMTH2 - intCOL
        rng.Formula = "=IF(SUM(IF(FREQUENCY(RC[" & intST & "]:RC[" _
                        & intEND & "],RC[" & intST & "]:RC[" & intEND _
                        & "])>0,1))>1,""False"","""")"
        rng.Copy
        rng.PasteSpecial xlPasteValues
        
        Set rng = ws.Range(ws.Cells(lngrowst, 1), ws.Cells(lngrow, lngcol))
        .AutoFilterMode = False
        rnghead.AutoFilter field:=intCOL, Criteria1:="False"
        rng.SpecialCells(xlCellTypeVisible).Copy
        wsM.Range("A4").PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=True, _
            Transpose:=True
    End With
    wsM.Select
End Sub
 
Upvote 0
Because I saw " intMTH1 = rnghead.Find("Jan").Column 'Change this to the header of the first column to be compared by the formula"
My columns are named with month and year, date format, and I wanted to change it in this format
 
Upvote 0
MEP1984 said:
Because I saw " intMTH1 = rnghead.Find("Jan").Column 'Change this to the header of the first column to be compared by the formula"
My columns are named with month and year, date format, and I wanted to change it in this format
Click to expand...

I get changing it to the date format, but the code you posted list AUG-16 as the subject of the .find. Why would that be the first column to start comparing. Should it not always be Jan of whatever year?

did the code work?
 
Upvote 0
Probably the file is used since Aug16 and the first information available is from then. Or maybe the older information was conciderred irrelevant for the check- I dont know. But despite the logic- this is what I have. Just wanted to skip the manual work with the macro, as the data is huge. I dont want to change the column names, as the file is used by a lot of people, and for somebody it might be important in a way.

Thanks a lot for your time, spent on that. I highly appreciate it!

It doesnt work with Aug-16, nor with 01/08/16, nor with 42583 (the number equivalence of the date...)
 
Last edited:
Upvote 0
ok one more try if this doesn't work we can hard code the starting column. I hate doing that but I am running out of ideas as to how to get this to work for me (which the last one did) AND more importantly work for you.

Code: 
Sub mep1984()
Dim wsM As Worksheet, ws As Worksheet
Dim lngrow As Long, lngcol As Long, lngrowst As Long
Dim rnghead As Range, rng As Range, cell As Range, rngDATE As Range
Dim intCOL As Integer, intMTH1 As Integer, intMTH2 As Integer, _
    intST As Integer, intEND As Integer
Dim strMTH As String
    strMTH = "Comparison" 'Change this to the formula header name
    lngrowst = 4
    Set wsM = Sheets("MEP1984 - macro") 'change this to Macro
    With wsM
        strMTH = wsM.Range("A2")
        If strMTH = "" Then
            MsgBox "Please enter a value into cell A2 to represent the " _
                        & "month year (ie: Nov16)." _
                        & vbNewLine & "Then start again."
            End
        End If
        lngrow = wsM.Range("A" & wsM.Rows.Count).End(xlUp).Row
        If Not lngrow = lngrowst - 2 Then
        
            lngcol = wsM.Cells(4, wsM.Columns.Count).End(xlToLeft).Column
            
            Set rng = wsM.Range(wsM.Cells(lngrowst, 1), wsM.Cells(lngrow, lngcol))
            rng.Delete Shift:=xlUp
        End If
    End With
    Set ws = Sheets(strMTH)
    ws.Select
    With ws
        lngrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        lngcol = ws.Cells(4, ws.Columns.Count).End(xlToLeft).Column
        intCOL = lngcol + 1
        ws.Cells(lngrowst, intCOL).Value = "Comparison" 'change to new field header
        Set rnghead = ws.Range(ws.Cells(lngrowst, 1), ws.Cells(lngrowst, intCOL))
        intMTH2 = lngcol
        Set rngDATE = rnghead.Find(DateValue("1 / 1 / 2016"))   'change date to your needs
        intMTH1 = rngDATE.Column
        Set rng = ws.Range(ws.Cells(lngrowst + 2, intCOL), _
            ws.Cells(lngrow, intCOL))
        intST = intMTH1 - intCOL
        intEND = intMTH2 - intCOL
        rng.Formula = "=IF(SUM(IF(FREQUENCY(RC[" & intST & "]:RC[" _
                        & intEND & "],RC[" & intST & "]:RC[" & intEND _
                        & "])>0,1))>1,""False"","""")"
        rng.Copy
        rng.PasteSpecial xlPasteValues
        
        Set rng = ws.Range(ws.Cells(lngrowst, 1), ws.Cells(lngrow, lngcol))
        .AutoFilterMode = False
        rnghead.AutoFilter field:=intCOL, Criteria1:="False"
        rng.SpecialCells(xlCellTypeVisible).Copy
        wsM.Range("A4").PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=True, _
            Transpose:=True
    End With
    wsM.Select
End Sub
 
Upvote 0
RCBricker said:
ok one more try if this doesn't work we can hard code the starting column. I hate doing that but I am running out of ideas as to how to get this to work for me (which the last one did) AND more importantly work for you.

Code: 
Sub mep1984()
Dim wsM As Worksheet, ws As Worksheet
Dim lngrow As Long, lngcol As Long, lngrowst As Long
Dim rnghead As Range, rng As Range, cell As Range, rngDATE As Range
Dim intCOL As Integer, intMTH1 As Integer, intMTH2 As Integer, _
    intST As Integer, intEND As Integer
Dim strMTH As String
    strMTH = "Comparison" 'Change this to the formula header name
    lngrowst = 4
    Set wsM = Sheets("MEP1984 - macro") 'change this to Macro
    With wsM
        strMTH = wsM.Range("A2")
        If strMTH = "" Then
            MsgBox "Please enter a value into cell A2 to represent the " _
                        & "month year (ie: Nov16)." _
                        & vbNewLine & "Then start again."
            End
        End If
        lngrow = wsM.Range("A" & wsM.Rows.Count).End(xlUp).Row
        If Not lngrow = lngrowst - 2 Then
        
            lngcol = wsM.Cells(4, wsM.Columns.Count).End(xlToLeft).Column
            
            Set rng = wsM.Range(wsM.Cells(lngrowst, 1), wsM.Cells(lngrow, lngcol))
            rng.Delete Shift:=xlUp
        End If
    End With
    Set ws = Sheets(strMTH)
    ws.Select
    With ws
        lngrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        lngcol = ws.Cells(4, ws.Columns.Count).End(xlToLeft).Column
        intCOL = lngcol + 1
        ws.Cells(lngrowst, intCOL).Value = "Comparison" 'change to new field header
        Set rnghead = ws.Range(ws.Cells(lngrowst, 1), ws.Cells(lngrowst, intCOL))
        intMTH2 = lngcol
        Set rngDATE = rnghead.Find(DateValue("1 / 1 / 2016"))   'change date to your needs
        intMTH1 = rngDATE.Column
        Set rng = ws.Range(ws.Cells(lngrowst + 2, intCOL), _
            ws.Cells(lngrow, intCOL))
        intST = intMTH1 - intCOL
        intEND = intMTH2 - intCOL
        rng.Formula = "=IF(SUM(IF(FREQUENCY(RC[" & intST & "]:RC[" _
                        & intEND & "],RC[" & intST & "]:RC[" & intEND _
                        & "])>0,1))>1,""False"","""")"
        rng.Copy
        rng.PasteSpecial xlPasteValues
        
        Set rng = ws.Range(ws.Cells(lngrowst, 1), ws.Cells(lngrow, lngcol))
        .AutoFilterMode = False
        rnghead.AutoFilter field:=intCOL, Criteria1:="False"
        rng.SpecialCells(xlCellTypeVisible).Copy
        wsM.Range("A4").PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=True, _
            Transpose:=True
    End With
    wsM.Select
End Sub
Click to expand...

Everything works now except for the part of true or false. The macro coppies all values, not only the false (unmatching)
 
Upvote 0
I changed the spelling and it seems to work :) ! I will review it further to check if everything seems ok and to play with different options- adding colums/rows for ex, to see how it will behave.
Thanks a lot for your time and effort! If everything goes as it seems to, it will save quite a lot of time and manual checking!
And, a bit late -Happy New Year :) !
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Macro to load 10 files from different folder into different sheets in Master File
Replies
2
Views
133
joxyin
J
B
  • Question
Paste results of Filter Function in place, or in separate sheet
Replies
0
Views
91
bertible
B
V
  • Question
Looking to create VBA command to go through List of sheet names, look up sheet name in range, look up value in cell next to it, and run a macro
Replies
3
Views
100
Volrin
V
K
  • Question
Excel script using if statement to copy/paste special values for specific rows
Replies
2
Views
175
kcampbell675
K
J
  • Question
VBA to select partial filename and go back and forth between two files to copy paste
Replies
1
Views
162
shknbk2
S

Forum statistics

Threads
1,214,788
Messages
6,121,580
Members
449,039
Latest member
Arbind kumar

Share this page

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