PDA

View Full Version : How to Join 2 Macro into 1



hardeep
06-22-2009, 01:13 AM
H!

I have 2 code. 1 for delete the Duplicate Blanks row in a Column and another one for "TRANSPOSE THE COLUMN INTO ROWS"


Now i want to Combine into 1. Dont want to Run These Macro 1 by 1

Code 1: Delete The Duplicate Blanks Row in a Column

Sub DeleteBlankRows()
'JBeaucaire (12/12/2008)
Dim i As Long, LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False

For i = LR To 2 Step -1
If Application.CountA(Cells(i, 1).EntireRow) = 0 And _
Application.CountA(Cells(i - 1, 1).EntireRow) = 0 Then _
Cells(i, 1).EntireRow.Delete
Next i

Application.ScreenUpdating = True
End Sub


Code 2: For Transpose The Column into Rows

Public Sub TransposePersonalData()
'ken johnson July 29, 2006
'transpose uneven sets of data........must have a blank row between
Application.ScreenUpdating = False
Dim rngData As Range
Dim iLastRow As Long
Dim i As Long
Dim iDataColumn As Integer
iDataColumn = Selection.Column
iLastRow = Cells(Application.Rows.Count, iDataColumn).End(xlUp).Row
i = Selection.Row - 1
Do While ActiveCell.Row < iLastRow
i = i + 1
Set rngData = Range(ActiveCell, ActiveCell.End(xlDown))
rngData.Copy
Cells(i, iDataColumn + 1).PasteSpecial Transpose:=True
rngData.Cells(rngData.Cells.Count + 2, 1).Activate
Loop
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Thanks in Advance

Hardeep Kanwar

shamsam1
06-22-2009, 03:21 AM
Sub combined()
DeleteBlankRows
TransposePersonalData
End Sub


try this

Bob Phillips
06-22-2009, 03:23 AM
Tut tut, who has been visiting other boards?



Sub DeleteBlankRows()
'JBeaucaire (12/12/2008)
Dim i As Long, LR As Long

LR = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False

For i = LR To 2 Step -1

If Application.CountA(Cells(i, 1).EntireRow) = 0 And _
Application.CountA(Cells(i - 1, 1).EntireRow) = 0 Then _
Rows(i).Delete
Next i

LR = Range("A" & Rows.Count).End(xlUp).Row
Range("A2").Resize(LR - 1).Copy
Range("B1").PasteSpecial Transpose:=True
Application.ScreenUpdating = True
End Sub

hardeep
06-22-2009, 03:26 AM
Tut tut, who has been visiting other boards?



Sub DeleteBlankRows()
'JBeaucaire (12/12/2008)
Dim i As Long, LR As Long

LR = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False

For i = LR To 2 Step -1

If Application.CountA(Cells(i, 1).EntireRow) = 0 And _
Application.CountA(Cells(i - 1, 1).EntireRow) = 0 Then _
Rows(i).Delete
Next i

LR = Range("A" & Rows.Count).End(xlUp).Row
Range("A2").Resize(LR - 1).Copy
Range("B1").PasteSpecial Transpose:=True
Application.ScreenUpdating = True
End Sub



It Show the Debug

Range("B1").PasteSpecial Transpose:=True

hardeep
06-22-2009, 03:29 AM
Sub combined()
DeleteBlankRows
TransposePersonalData
End Sub


try this



No, Its Not Working

I am totally Stupid in VBA or Macros

Bob Phillips
06-22-2009, 04:52 AM
Can you post the workbook, with the code as you added it?

hardeep
06-22-2009, 05:02 AM
Can you post the workbook, with the code as you added it?


Kindly Find the Attach

Bob Phillips
06-22-2009, 05:25 AM
I think it is impossible to know what rows to delete in that data. The code you gave doesn't do it, and I cannot see anything that can be tested for to know when to delete.