ExcelBanter - Run macro on Active sheet

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Run macro on Active sheet - Columns to rows (https://www.excelbanter.com/excel-programming/433189-run-macro-active-sheet-columns-rows.html)

Run macro on Active sheet - Columns to rows

Hello,

Below is code to move data from columns to rows.
It is current set to work on "Sheet1" but I would like to be able to
run it on the "activesheet" -how can I do this?

I have tried simply changing to "activesheet" or
sheets.application.activesheet however the macro just continues to
loop rather that posting data into rows.

Any advice would be appreciated.

Sub CWI_Column2Rows()
Dim Table As Range
Dim DestinationLoc As Range
Dim WS As Worksheet
Set WS = Sheets.Add
'-----------------------------------------------------------------

With Sheets("Sheet1")
Set startCell = .Range("A1")
LastCol = startCell.End(xlToRight).Column
LastRow = startCell.End(xlDown).Row
Set Table = .Range(startCell, .Cells(LastRow, LastCol))
End With
Set DestinationLoc = WS.Range("A1")
Call CWI_MakeRows(Table, DestinationLoc)

End Sub
Sub CWI_MakeRows(Target As Range, Destination As Range)

NumCols = Target.Columns.Count
numRows = Target.Rows.Count
NewRowOffset = 0
'Skip header row
For RowOffset = 2 To numRows
'skip header column
For ColOffset = 2 To NumCols
Destination.Offset(NewRowOffset, 0) = Target(RowOffset,
1).Value
Destination.Offset(NewRowOffset, 1) = Target(1,
ColOffset).Value
Destination.Offset(NewRowOffset, 2) = Target(RowOffset,
ColOffset)
NewRowOffset = NewRowOffset + 1

Next ColOffset
Next RowOffset
End Sub

Don Guillett

Run macro on Active sheet - Columns to rows

with activesheet

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"ra" wrote in message
...
Hello,

Below is code to move data from columns to rows.
It is current set to work on "Sheet1" but I would like to be able to
run it on the "activesheet" -how can I do this?

I have tried simply changing to "activesheet" or
sheets.application.activesheet however the macro just continues to
loop rather that posting data into rows.

Any advice would be appreciated.

Sub CWI_Column2Rows()
Dim Table As Range
Dim DestinationLoc As Range
Dim WS As Worksheet
Set WS = Sheets.Add
'-----------------------------------------------------------------

With Sheets("Sheet1")
Set startCell = .Range("A1")
LastCol = startCell.End(xlToRight).Column
LastRow = startCell.End(xlDown).Row
Set Table = .Range(startCell, .Cells(LastRow, LastCol))
End With
Set DestinationLoc = WS.Range("A1")
Call CWI_MakeRows(Table, DestinationLoc)

End Sub
Sub CWI_MakeRows(Target As Range, Destination As Range)

NumCols = Target.Columns.Count
numRows = Target.Rows.Count
NewRowOffset = 0
'Skip header row
For RowOffset = 2 To numRows
'skip header column
For ColOffset = 2 To NumCols
Destination.Offset(NewRowOffset, 0) = Target(RowOffset,
1).Value
Destination.Offset(NewRowOffset, 1) = Target(1,
ColOffset).Value
Destination.Offset(NewRowOffset, 2) = Target(RowOffset,
ColOffset)
NewRowOffset = NewRowOffset + 1

Next ColOffset
Next RowOffset
End Sub

Patrick Molloy[_2_]

Run macro on Active sheet - Columns to rows

change this
Set WS = Sheets.Add

to this
Set WS = activesheet

"ra" wrote:

Hello,

Below is code to move data from columns to rows.
It is current set to work on "Sheet1" but I would like to be able to
run it on the "activesheet" -how can I do this?

I have tried simply changing to "activesheet" or
sheets.application.activesheet however the macro just continues to
loop rather that posting data into rows.

Any advice would be appreciated.

Sub CWI_Column2Rows()
Dim Table As Range
Dim DestinationLoc As Range
Dim WS As Worksheet
Set WS = Sheets.Add
'-----------------------------------------------------------------

With Sheets("Sheet1")
Set startCell = .Range("A1")
LastCol = startCell.End(xlToRight).Column
LastRow = startCell.End(xlDown).Row
Set Table = .Range(startCell, .Cells(LastRow, LastCol))
End With
Set DestinationLoc = WS.Range("A1")
Call CWI_MakeRows(Table, DestinationLoc)

End Sub
Sub CWI_MakeRows(Target As Range, Destination As Range)

NumCols = Target.Columns.Count
numRows = Target.Rows.Count
NewRowOffset = 0
'Skip header row
For RowOffset = 2 To numRows
'skip header column
For ColOffset = 2 To NumCols
Destination.Offset(NewRowOffset, 0) = Target(RowOffset,
1).Value
Destination.Offset(NewRowOffset, 1) = Target(1,
ColOffset).Value
Destination.Offset(NewRowOffset, 2) = Target(RowOffset,
ColOffset)
NewRowOffset = NewRowOffset + 1

Next ColOffset
Next RowOffset
End Sub

Patrick Molloy[_2_]

Run macro on Active sheet - Columns to rows

beg pardon
ws is is used for the destination

instead change this
With Sheets("Sheet1")

to
With ActiveSheet

"ra" wrote:

Hello,

Below is code to move data from columns to rows.
It is current set to work on "Sheet1" but I would like to be able to
run it on the "activesheet" -how can I do this?

I have tried simply changing to "activesheet" or
sheets.application.activesheet however the macro just continues to
loop rather that posting data into rows.

Any advice would be appreciated.

Sub CWI_Column2Rows()
Dim Table As Range
Dim DestinationLoc As Range
Dim WS As Worksheet
Set WS = Sheets.Add
'-----------------------------------------------------------------

With Sheets("Sheet1")
Set startCell = .Range("A1")
LastCol = startCell.End(xlToRight).Column
LastRow = startCell.End(xlDown).Row
Set Table = .Range(startCell, .Cells(LastRow, LastCol))
End With
Set DestinationLoc = WS.Range("A1")
Call CWI_MakeRows(Table, DestinationLoc)

End Sub
Sub CWI_MakeRows(Target As Range, Destination As Range)

NumCols = Target.Columns.Count
numRows = Target.Rows.Count
NewRowOffset = 0
'Skip header row
For RowOffset = 2 To numRows
'skip header column
For ColOffset = 2 To NumCols
Destination.Offset(NewRowOffset, 0) = Target(RowOffset,
1).Value
Destination.Offset(NewRowOffset, 1) = Target(1,
ColOffset).Value
Destination.Offset(NewRowOffset, 2) = Target(RowOffset,
ColOffset)
NewRowOffset = NewRowOffset + 1

Next ColOffset
Next RowOffset
End Sub

Patrick Molloy[_2_]

Run macro on Active sheet - Columns to rows

Q: Why not just copy the data and use pastespecial TRANSPOSE?

"ra" wrote:

Hello,

Below is code to move data from columns to rows.
It is current set to work on "Sheet1" but I would like to be able to
run it on the "activesheet" -how can I do this?

I have tried simply changing to "activesheet" or
sheets.application.activesheet however the macro just continues to
loop rather that posting data into rows.

Any advice would be appreciated.

Sub CWI_Column2Rows()
Dim Table As Range
Dim DestinationLoc As Range
Dim WS As Worksheet
Set WS = Sheets.Add
'-----------------------------------------------------------------

With Sheets("Sheet1")
Set startCell = .Range("A1")
LastCol = startCell.End(xlToRight).Column
LastRow = startCell.End(xlDown).Row
Set Table = .Range(startCell, .Cells(LastRow, LastCol))
End With
Set DestinationLoc = WS.Range("A1")
Call CWI_MakeRows(Table, DestinationLoc)

End Sub
Sub CWI_MakeRows(Target As Range, Destination As Range)

NumCols = Target.Columns.Count
numRows = Target.Rows.Count
NewRowOffset = 0
'Skip header row
For RowOffset = 2 To numRows
'skip header column
For ColOffset = 2 To NumCols
Destination.Offset(NewRowOffset, 0) = Target(RowOffset,
1).Value
Destination.Offset(NewRowOffset, 1) = Target(1,
ColOffset).Value
Destination.Offset(NewRowOffset, 2) = Target(RowOffset,
ColOffset)
NewRowOffset = NewRowOffset + 1

Next ColOffset
Next RowOffset
End Sub

Run macro on Active sheet - Columns to rows

On Sep 3, 10:40*am, Patrick Molloy
wrote:
change this
Set WS = Sheets.Add

to this
Set WS = activesheet

"ra" wrote:
Hello,

Below is code to move data from columns to rows.
It is current set to work on "Sheet1" but I would like to be able to
run it on the "activesheet" -how can I do this?

I have tried simply changing to "activesheet" or
sheets.application.activesheet however the macro just continues to
loop rather that posting data into rows.

Any advice would be appreciated.

Sub CWI_Column2Rows()
Dim Table As Range
Dim DestinationLoc As Range
Dim WS As Worksheet
Set WS = Sheets.Add
'-----------------------------------------------------------------

With Sheets("Sheet1")
* *Set startCell = .Range("A1")
* *LastCol = startCell.End(xlToRight).Column
* *LastRow = startCell.End(xlDown).Row
* *Set Table = .Range(startCell, .Cells(LastRow, LastCol))
End With
Set DestinationLoc = WS.Range("A1")
Call CWI_MakeRows(Table, DestinationLoc)

End Sub
Sub CWI_MakeRows(Target As Range, Destination As Range)

NumCols = Target.Columns.Count
numRows = Target.Rows.Count
NewRowOffset = 0
'Skip header row
For RowOffset = 2 To numRows
* *'skip header column
* *For ColOffset = 2 To NumCols
* * * * Destination.Offset(NewRowOffset, 0) = Target(RowOffset,
1).Value
* * * * Destination.Offset(NewRowOffset, 1) = Target(1,
ColOffset).Value
* * * * Destination.Offset(NewRowOffset, 2) = Target(RowOffset,
ColOffset)
* * * * NewRowOffset = NewRowOffset + 1

* *Next ColOffset
Next RowOffset
End Sub- Hide quoted text -

- Show quoted text -

Hi,
Thanks for help however that doesnt work in this case as:
WS is the new sheet created to post the data in to so I can't make
this the active sheet or the data will post overtop of source.

I have tried changing 'With Sheets("Sheet1") to "With Activesheet"
however then the macro wont solve and just keeps loading.

regards
Richard

Run macro on Active sheet - Columns to rows

On Sep 3, 10:44*am, Patrick Molloy
wrote:
Q: Why not just copy the data and use pastespecial TRANSPOSE?

"ra" wrote:
Hello,

Below is code to move data from columns to rows.
It is current set to work on "Sheet1" but I would like to be able to
run it on the "activesheet" -how can I do this?

I have tried simply changing to "activesheet" or
sheets.application.activesheet however the macro just continues to
loop rather that posting data into rows.

Any advice would be appreciated.

Sub CWI_Column2Rows()
Dim Table As Range
Dim DestinationLoc As Range
Dim WS As Worksheet
Set WS = Sheets.Add
'-----------------------------------------------------------------

With Sheets("Sheet1")
* *Set startCell = .Range("A1")
* *LastCol = startCell.End(xlToRight).Column
* *LastRow = startCell.End(xlDown).Row
* *Set Table = .Range(startCell, .Cells(LastRow, LastCol))
End With
Set DestinationLoc = WS.Range("A1")
Call CWI_MakeRows(Table, DestinationLoc)

End Sub
Sub CWI_MakeRows(Target As Range, Destination As Range)

NumCols = Target.Columns.Count
numRows = Target.Rows.Count
NewRowOffset = 0
'Skip header row
For RowOffset = 2 To numRows
* *'skip header column
* *For ColOffset = 2 To NumCols
* * * * Destination.Offset(NewRowOffset, 0) = Target(RowOffset,
1).Value
* * * * Destination.Offset(NewRowOffset, 1) = Target(1,
ColOffset).Value
* * * * Destination.Offset(NewRowOffset, 2) = Target(RowOffset,
ColOffset)
* * * * NewRowOffset = NewRowOffset + 1

* *Next ColOffset
Next RowOffset
End Sub- Hide quoted text -

- Show quoted text -

Hi,
I cant use TRANSPOSE as that doesnt put the data into the correct
format. I need each variable in a seperate column and each change to
be pasted below.

Patrick Molloy[_2_]

Run macro on Active sheet - Columns to rows

yes, sorry, see my later post

"ra" wrote:

On Sep 3, 10:40 am, Patrick Molloy
wrote:
change this
Set WS = Sheets.Add

to this
Set WS = activesheet

"ra" wrote:
Hello,

Below is code to move data from columns to rows.
It is current set to work on "Sheet1" but I would like to be able to
run it on the "activesheet" -how can I do this?

I have tried simply changing to "activesheet" or
sheets.application.activesheet however the macro just continues to
loop rather that posting data into rows.

Any advice would be appreciated.

Sub CWI_Column2Rows()
Dim Table As Range
Dim DestinationLoc As Range
Dim WS As Worksheet
Set WS = Sheets.Add
'-----------------------------------------------------------------

With Sheets("Sheet1")
Set startCell = .Range("A1")
LastCol = startCell.End(xlToRight).Column
LastRow = startCell.End(xlDown).Row
Set Table = .Range(startCell, .Cells(LastRow, LastCol))
End With
Set DestinationLoc = WS.Range("A1")
Call CWI_MakeRows(Table, DestinationLoc)

End Sub
Sub CWI_MakeRows(Target As Range, Destination As Range)

NumCols = Target.Columns.Count
numRows = Target.Rows.Count
NewRowOffset = 0
'Skip header row
For RowOffset = 2 To numRows
'skip header column
For ColOffset = 2 To NumCols
Destination.Offset(NewRowOffset, 0) = Target(RowOffset,
1).Value
Destination.Offset(NewRowOffset, 1) = Target(1,
ColOffset).Value
Destination.Offset(NewRowOffset, 2) = Target(RowOffset,
ColOffset)
NewRowOffset = NewRowOffset + 1

Next ColOffset
Next RowOffset
End Sub- Hide quoted text -

- Show quoted text -

Hi,
Thanks for help however that doesnt work in this case as:
WS is the new sheet created to post the data in to so I can't make
this the active sheet or the data will post overtop of source.

I have tried changing 'With Sheets("Sheet1") to "With Activesheet"
however then the macro wont solve and just keeps loading.

regards
Richard

Don Guillett

Run macro on Active sheet - Columns to rows

Sub MakeNewSheetFromAnySheetSAS()
Dim lc As Double
Dim i As Long
Dim dlr As Long
Dim SourceSheet As String

Application.ScreenUpdating = False
SourceSheet = ActiveSheet.Name
lc = Cells(1, Columns.Count).End(xlToLeft).Column
Sheets.Add
With Sheets(SourceSheet)
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
dlr = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(dlr, 1).Resize(lc - 1).Value = .Cells(i, 1).Value
.Cells(1, 2).Resize(, lc - 1).Copy
Cells(dlr, 2).PasteSpecial Paste:=xlPasteValues, Transpose:=True

.Cells(i, 2).Resize(, lc - 1).Copy
Cells(dlr, 3).PasteSpecial Paste:=xlPasteAll, Transpose:=True
Next i
End With
'housekeeping
Range("a2").Select
ActiveWindow.FreezePanes = True
Range("a1") = "Category"
Range("b1") = "Mon"
Range("c1") = " Amount"
Columns(3).Style = "Comma"
Columns.AutoFit
'===
Application.ScreenUpdating = True
'MsgBox "Done"
ActiveSheet.Name = InputBox("Enter New Sheet Name")
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Don Guillett" wrote in message
...
with activesheet

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"ra" wrote in message
...
Hello,

Below is code to move data from columns to rows.
It is current set to work on "Sheet1" but I would like to be able to
run it on the "activesheet" -how can I do this?

I have tried simply changing to "activesheet" or
sheets.application.activesheet however the macro just continues to
loop rather that posting data into rows.

Any advice would be appreciated.

Sub CWI_Column2Rows()
Dim Table As Range
Dim DestinationLoc As Range
Dim WS As Worksheet
Set WS = Sheets.Add
'-----------------------------------------------------------------

With Sheets("Sheet1")
Set startCell = .Range("A1")
LastCol = startCell.End(xlToRight).Column
LastRow = startCell.End(xlDown).Row
Set Table = .Range(startCell, .Cells(LastRow, LastCol))
End With
Set DestinationLoc = WS.Range("A1")
Call CWI_MakeRows(Table, DestinationLoc)

End Sub
Sub CWI_MakeRows(Target As Range, Destination As Range)

NumCols = Target.Columns.Count
numRows = Target.Rows.Count
NewRowOffset = 0
'Skip header row
For RowOffset = 2 To numRows
'skip header column
For ColOffset = 2 To NumCols
Destination.Offset(NewRowOffset, 0) = Target(RowOffset,
1).Value
Destination.Offset(NewRowOffset, 1) = Target(1,
ColOffset).Value
Destination.Offset(NewRowOffset, 2) = Target(RowOffset,
ColOffset)
NewRowOffset = NewRowOffset + 1

Next ColOffset
Next RowOffset
End Sub

All times are GMT +1. The time now is 04:44 AM.