Xl2007 Find Replace VBA Increment Column Letter

[CiaranEire]

Hi,

I am setting up an excel file to use as a database (MSAccess currently not an option) with a data entry sheet and a table sheet. The data entry sheet is set up to use 8 columns per day times 365 days (data is entered in columns B to DHQ). I have set it up like this as it is the currently the method best suited to my needs (Vs. using a VBA form).

What I am seeking help with is linking the table sheet to the data entry sheet. I have pasted the links for the first data column (B) and transposed for them to be in table format. Now I need a macro to copy the first row and paste down, incrementally increasing the column by 1 each time. So, B becomes C, C becomes D etc.

Here is my sample code:

Sub CopyTableDown()


Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


Dim replacecol As String
Dim x As Integer


replacecol = 2 'or B
Application.CutCopyMode = False
Sheet2.Range("A2:CB2").Copy
For x = 1 To 7 'or to 2928 for B to DHQ
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Selection.Replace What:=replacecol, Replacement:=[COLOR=#ff0000][B]replacecol + 1[/B][/COLOR], LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    replacecol = [COLOR=#ff0000][B]replacecol + 1[/B][/COLOR]
Next x


Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True


End Sub

What I know about VBA has been learned through trial and error and adapting code found on forums so all help is greatly appreciated. I will gladly clarify if any of the above isn't clear or if not as it should be according to forum best practices.

Ciaran

 

[pbornemeier]

I do not understand the desired relationship between the data entry and the table sheet.

Do you want to copy data as follows:
Data Entry B2:I2 to Table A1:A8, Data Entry J2:Q2 to Table B1:B8, .... , Data Entry DHJ2:DHQ2 to Table NA1:NA8

Why does the above code select A2:CB2

 

[CiaranEire]

Do you want to copy data as follows:
Data Entry B2:I2 to Table A1:A8, Data Entry J2:Q2 to Table B1:B8, .... , Data Entry DHJ2:DHQ2 to Table NA1:NA8

Apologies, what I am looking for is Data Entry B101:B180 to Table A2:CB2, Data Entry C101:C180 to Table A3:CB3, .... , Data Entry DHQ101:DHQ180 to Table A2929:CB2929.

Thanks for the reply.

 

[CiaranEire]

Why does the above code select A2:CB2

I should have clarified, I have already entered the first row (2) in the Table (Row 1 is labels) which links to the first column (B) in the Data Entry (column A is labels). So, in the macro, I am copying the first row of the Table, pasting in the next row and doing a Find/Replace to look to next column in the Data Entry.

PS
'Replacecol' should be declared as Integer in sample code above as you may have seen

 

[CiaranEire]

Phil, thinking about it some more and doing other searches I've found other ways of achieving what I needed. Per user VoG on the thread http://www.mrexcel.com/forum/excel-...-applications-copy-column-data-into-rows.html, I can use the transpose method and place it in the Worksheet.Deactivate event to transpose values instead of maintaining permanent links.

On reading your post I realised another way to phrase my question would be to ask how to copy data in columns to rows and paste as link in another sheet. That took me to the thread above. The beauty of forums, I wouldn't have thought of it in that way without your reply, so it's much appreciated.

I'd still be interested to know if it's possible to do it as I originally intended if anybody finds a solution.

Ciaran

 

[pbornemeier]

This code will perform the copying you described in post #3

Sub CopyRowsToColumns()

    Dim rngSourceReferenceCell As Range
    Dim rngDestinationReferenceCell As Range
    Dim lLastColumnToCopy As Long
    Dim lLastRowToCopy As Long
    Dim oFound As Object
    Dim lX As Long
    
    Set rngSourceReferenceCell = Worksheets("Data Entry").Range("B101")
    Set rngDestinationReferenceCell = Worksheets("Table").Range("A2")
    
    'If lLastColumnToCopy or lLastRowToCopy are fixed, then set that value rather than use the formulas below
    
    With Worksheets("Data Entry")
        'Find the bottom and right edge of the block to be copied
        lLastColumnToCopy = .Rows(rngSourceReferenceCell.Row).Find(What:="*", LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Column
        lLastRowToCopy = .Columns(rngSourceReferenceCell.Column).Find(What:="*", LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Row
        
        'Copy each column to next row
        For lX = rngSourceReferenceCell.Column To lLastColumnToCopy
            .Range(.Cells(rngSourceReferenceCell.Row, lX), .Cells(lLastRowToCopy, lX)).Copy
            Worksheets("Table").Cells(lX, 1).PasteSpecial Paste:=xlPasteAll, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Next
        
    End With
       
    Set rngSourceReferenceCell = Nothing
    Set rngDestinationReferenceCell = Nothing
       
End Sub

 

[CiaranEire]

Hi Phil, that achieves exactly what I asked for, thanks.

Ciaran