VBA Excel Help needed

[PiratesFan]

Hey everyone,
I am new to this forum and relatively new to VBA programming so I hope that I can explain myself clearly enough that you all can understand.

Here it goes...

I have a spreadsheet that I import data into from a CAD packing that I use. When I extract the data from my CAD software, it inputs that data into columns in Excel. Specifically E, F and G. Depending on the number of drawings that I am pulling data from, I could have upwards of 3000 rows. Columns E, F and G are labeled Drawing Description 1, Drawing Description 2 and Filename, respectively. I then have to take those columns and transpose them so that Column E would now be row 11, Column F would be row 12 and Column G would be row 13. I have written the script to complete the steps that I just mentioned.

Code:
Sub Copy_Paste_Transpose2()
'
' Copy_Paste_Transpose2 Macro
' Copies, pastes and transposes data to be formatted for WDP editor
'
' Keyboard Shortcut: Ctrl+Shift+W
'
Dim lastrow As Long
lastrow = Range("E65536").End(xlUp).Row
Range("E11:G" & lastrow).Select
Selection.Copy
Range("I11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False

End Sub

This was the easy part.
Now, my end goal is to move 3 rows of data, one column at a time, beginning with J11:J13, down to I14:I16. Then move K11:K13 to I17:I19 and so on until there is no more data to be moved from what was just transposed. Once I transpose Columns E, F and G, there could be an infinite amount of columns used, beginning with column I. Can anybody help me out with this?

 

[douglasb]

I've never used VBA (and never plan to), but it sounds like you might be looking for a For Each loop or a While loop.

 

[PowerEngineer]

Given how much additional power macros add to Excel, it's certainly a good idea to learn VBA; I certainly don't want to discourage you.

On the other hand, I would consider building a two-sheet workbook where the first sheet is the "landing zone" for your columner CAD (E:G) and the second sheet uses simple cell formulas pointing to the first sheet cells to rearrange the data into the format you want it to be in.

May be a bit tedious. I'd probably define the sheet one E:G as a named range and then use indexing in the second sheet formulas.

Otherwise, you will want to set up a loop that goes through the columns in your transposed data one at a time.

 

[postmark]

If I have time tonight I can work something up for you.

 

[postmark]

This should work for you:

Sub test()
'find last row of data
Dim lastrow As Integer
lastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "E").End(xlUp).Row
'iterate from column E (5) to column G (7)
For i = 5 To 7
    'set start column as H (8) for transposing to rows
    columncounter = 8
    'iterate from E/F/G,11 down to lastrow of data
    For j = 11 To lastrow
        'select and copy current data
        ActiveSheet.Cells(j, i).Select
        Selection.Copy
        'paste into new cell based on current column
        ActiveSheet.Cells(i + 6, columncounter).Select
        ActiveSheet.Paste
        columncounter = columncounter + 1
    Next j
    
Next i
    
    
    


End Sub

 

[Tweak155]

I'm confused... not sure why you'd do this (practice?). You have less space with columns than you do rows.

Is there a reason you don't do something with the data while they are in columns?

 

[postmark]

I was confused too

 

[PiratesFan]

Thanks everyone! The reason I need this format is because I can rewrite the script behind project files in autocad. I can add an unlimited number of drawings to a project file and these drawings within the project should all have the same title block with the same attributes. When I extract the data from these attributes within autocad, it outputs the information in rows. Once the data is in Excel, I can modify it easier and faster than opening up each individual drawing. Once that data is edited, I need to get it back to those title blocks. The WDP file for the autocad project that I set up can be edited to achieve this. However, the information has to be in columns rather than in rows. Sorry if I did not explain well enough. But again, Thanks for the replies!

 

[PiratesFan]

This works for the copy and transpose part, which is the portion that I already wrote. I am in need of a way to copy those columns into a column format so that I can use the new data in my WDP text file.

 

[PiratesFan]

The reason I do this is because the .wdp file that I have to paste my new information in has to be formatted with column E in line one, column F in line two and column G in line 3. So when I transpose the data it gets the date from E, F and G and puts it in rows 11, 12 and 13. The problem is that my newly transposed data is in an unknown number of columns with 3 rows each. I need all of that data to be put into one column so that I can export that data from excel to my .wdp file.

Thanks, postmark, for writing that script, but that just transposes the data which is the script that I have already written. I am in need of the script to copy the transposed data and stores it in one column.

 

[PiratesFan]

I got the end result by recording a macro to see what the script would be. The problem is, there is an unknown amount of data that I will have to process. So the script needs to be formatted so that it would process an unlimited amount of columns. Here is the step by step process that was recorded by recording the macro. I hope it will help you guys see exactly what I am trying to accomplish.


code:

Range("J11:J13").Select
Selection.Cut Destination:=Range("I14:I16")
Range("K11:K13").Select
Selection.Cut Destination:=Range("I17:I19")
Range("L11:L13").Select
Selection.Cut Destination:=Range("I20:I22")
Range("M11:M13").Select
Selection.Cut Destination:=Range("I23:I25")
Range("N11:N13").Select
Selection.Cut Destination:=Range("I26:I28")
Range("O11:O13").Select
Selection.Cut Destination:=Range("I29:I31")
Range("P1113").Select
Selection.Cut Destination:=Range("I32:I34")
Range("Q11:Q13").Select
Selection.Cut Destination:=Range("I35:I37")
Range("R11:R13").Select
Selection.Cut Destination:=Range("I39:I41")
Range("S11:S13").Select
Selection.Cut Destination:=Range("I42:I44")
Range("T11:T13").Select
Selection.Cut Destination:=Range("I45:I47")

 

[Tweak155]

I got the end result by recording a macro to see what the script would be. The problem is, there is an unknown amount of data that I will have to process. So the script needs to be formatted so that it would process an unlimited amount of columns. Here is the step by step process that was recorded by recording the macro. I hope it will help you guys see exactly what I am trying to accomplish.


code:

Range("J11:J13").Select
Selection.Cut Destination:=Range("I14:I16")
Range("K11:K13").Select
Selection.Cut Destination:=Range("I17:I19")
Range("L11:L13").Select
Selection.Cut Destination:=Range("I20:I22")
Range("M11:M13").Select
Selection.Cut Destination:=Range("I23:I25")
Range("N11:N13").Select
Selection.Cut Destination:=Range("I26:I28")
Range("O11:O13").Select
Selection.Cut Destination:=Range("I29:I31")
Range("P1113").Select
Selection.Cut Destination:=Range("I32:I34")
Range("Q11:Q13").Select
Selection.Cut Destination:=Range("I35:I37")
Range("R11:R13").Select
Selection.Cut Destination:=Range("I39:I41")
Range("S11:S13").Select
Selection.Cut Destination:=Range("I42:I44")
Range("T11:T13").Select
Selection.Cut Destination:=Range("I45:I47")

Code that would simulate what you have there but without knowing how far the columns go:

Dim curCopyRng as Range, curDestRng as Range

Set curCopyRng = Range("J11:J13")

Set curDestRng = Range("I14:I16")

While curCopyRng(1, 1).Value <> "" Or curCopyRng(2, 1).Value <> "" Or curCopyRng(3, 1).Value <> ""
    curCopyRng.Select
    Selection.Cut Destination:=curDestRng
    Set curCopyRng = curCopyRng.Offset(0, 1)
    Set curDestRng = curDestRng.Offset(3, 0)
Wend

See if that works.

 

[PiratesFan]

Thanks Tweak155. I get a Run-Time error '424': Object required, every time I run this. When I hit Debug, it highlights "Set curDestRng = curDestRng.Offset(3, 0)". I hover over it and it says "curDestRng.Offset(3,0)=<Object required>". Do you know what that means or what it is looking for?

 

[Tweak155]

Thanks Tweak155. I get a Run-Time error '424': Object required, every time I run this. When I hit Debug, it highlights "Set curDestRng = curDestRng.Offset(3, 0)". I hover over it and it says "curDestRng.Offset(3,0)=<Object required>". Do you know what that means or what it is looking for?

So just tested it, apparently the Cut operation clears out the range object. Try the following:

Private Sub CommandButton1_Click()
Dim curCopyRng As Range, curDestRng As Range, strRng As String, strRng2 As String


Set curCopyRng = Range("J11:J13")

Set curDestRng = Range("I14:I16")

While curCopyRng(1, 1).Value <> "" Or curCopyRng(2, 1).Value <> "" Or curCopyRng(3, 1).Value <> ""
    strRng = curDestRng.Address
    strRng2 = curCopyRng.Address
    curCopyRng.Select
    Selection.Cut Destination:=curDestRng
    Set curCopyRng = Range(strRng2).Offset(0, 1)
    Set curDestRng = Range(strRng).Offset(3, 0)
Wend
End Sub

Thanks.

 

[PiratesFan]

Works like a charm! Thank you. Only one more thing, after the script is ran, it leaves the workbook looking as the last column that HAD the information in it. How do I get it to return to the beginning of the sheet?

 

[Tweak155]

Works like a charm! Thank you. Only one more thing, after the script is ran, it leaves the workbook looking as the last column that HAD the information in it. How do I get it to return to the beginning of the sheet?

Range("A1").Select... or whatever cell you want it to do.

Also if it still highlights something as Cut, you can do:

Application.CutCopyMode = False

 

[Tweak155]

Also, if you have lots of data it is going through, you can speed it up greatly by adding:

Application.ScreenUpdating = False

.... sub code here
Application.ScreenUpdating = True

Add that to the very beginning and very end of the sub. It will go a lot faster.

 

[PiratesFan]

Thanks so much for the help. IT works great.

 

[postmark]

Sorry, I didn't realize that you wanted it into 1 column. If that's the case, then just going straight to 1 column will be WAY faster. This code will work for that:

Sub test()
'find last row of data
Dim lastrow As Integer
lastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "E").End(xlUp).Row
'start at row 11 in column I for final data
rowcounter = 11

Application.ScreenUpdating = False
'iterate from E/F/G,11 down to lastrow of data
For j = 11 To lastrow
        
    'iterate from column E (5) to column G (7)
    For i = 5 To 7
        'select and copy current data
        ActiveSheet.Cells(j, i).Select
        Selection.Copy
        'paste into new cell based on current column
        ActiveSheet.Cells(rowcounter, 9).Select
        ActiveSheet.Paste
        rowcounter = rowcounter + 1
    Next i
    
Next j
    
    
Range("I11").Select
Application.ScreenUpdating = True

    


End Sub