PDA

View Full Version : Need Macro to create a Format



vishwakarma
05-21-2012, 10:28 AM
Hello Guys,

Need a small help in creating a macro which will segregate the data in a summarized format. Please refer the attach excel file for clear picture. Many thanks for the help.

Please Note: List can vary in numbers.


Many Thanks,
Manoj Kumar

Bob Phillips
05-21-2012, 10:57 AM
Sub ProcessData()
Dim testValue As Long
Dim bandText As String
Dim lastrow As Long
Dim i As Long

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Columns("A").Insert
testValue = 45
bandText = "45+"
For i = lastrow - 1 To 1 Step -1

If Not .Cells(i, "C").Value >= testValue Then

.Cells(i + 1, "A").Resize(, 3).Insert Shift:=xlDown
.Cells(i + 1, "A").Value = bandText
.Cells(i + 1, "A").Resize(, 3).Interior.ColorIndex = 15
If testValue = 45 Then

testValue = 40
bandText = "40"
Else

testValue = 30
bandText = "30-35"
End If
End If
Next i

.Columns("C").Copy
.Columns("A").PasteSpecial Paste:=xlPasteFormats
End With

Application.CutCopyMode = False
End Sub

vishwakarma
05-22-2012, 04:41 AM
Thank you! xld....it's just perfect.. Thanks again

vishwakarma
05-22-2012, 04:45 AM
Just one more thing; it;s not categorizing the lowest category, i.e. not giving the header "30-35"...

Thanks,

Bob Phillips
05-22-2012, 05:08 AM
This should fix it

Sub ProcessData()
Dim testValue As Long
Dim bandText As String
Dim lastrow As Long
Dim i As Long

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Columns("A").Insert
testValue = 45
bandText = "45+"
For i = lastrow - 1 To 1 Step -1

If Not .Cells(i, "C").Value >= testValue Or i = 1 Then

.Cells(i + 1, "A").Resize(, 3).Insert Shift:=xlDown
.Cells(i + 1, "A").Value = bandText
.Cells(i + 1, "A").Resize(, 3).Interior.ColorIndex = 15
If testValue = 45 Then

testValue = 40
bandText = "40"
Else

testValue = 30
bandText = "30-35"
End If
End If
Next i

.Columns("C").Copy
.Columns("A").PasteSpecial Paste:=xlPasteFormats
End With

Application.CutCopyMode = False
End Sub

vishwakarma
05-22-2012, 05:27 AM
Thanks a lot; xld.. it working now... :yes