maverick0987
New member
- Joined
- Apr 15, 2013
- Messages
- 2
- Reaction score
- 0
- Points
- 0
Greetings,
6 months ago someone here helped me build a macro to reformat a report. I own a property management company and I use this report to list my current vacancies. The way it is generated through my management software is very difficult to read and is poorly designed. After installing an update to the software it changed the look and cell placement of the report and so my macro will not work. I have tried changing the cell assignments for the variables but some of the coding was a little over my head. I have included the macro if anyone can help explain to me how it is worked Any help or advice would be greatly appreciated! Thank you!
-J
Sub aaa()
Dim OutSH As Worksheet
cntr = 0
Set OutSH = Sheets.Add(after:=Sheets(1))
ActiveSheet.Name = "Output"
OutSH.Range("A1").Value = "UNIT AVAILABILITY FOR RENT MAXIMIZER PRICING MODEL"
Range("G1").Formula = "=today()"
Sheets(1).Activate
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Left(Cells(i, 2), 5) = "Unit:" Then unit = Right(Cells(i, 4), Len(Cells(i, 1)) - 6)
If Left(Cells(i, 1), 10) = "Unit Type:" Then unittype = Right(Cells(i, 1), Len(Cells(i, 1)) - 11)
If Left(Cells(i, 1), 12) = "Market Rent:" Then mktrent = Right(Cells(i, 1), Len(Cells(i, 1)) - 13)
If Left(Cells(i, 1), 12) = "Unit Status:" Then unitstatus = Right(Cells(i, 1), Len(Cells(i, 1)) - 13)
If Left(Cells(i, 1), 11) = "Date Ready:" Then dateready = Right(Cells(i, 1), Len(Cells(i, 1)) - 12)
If Cells(i, 1) = "Lease Term" Then
outrow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Row
OutSH.Cells(outrow, 1).Value = "Unit Type:"
OutSH.Cells(outrow, 1).Font.Bold = True
OutSH.Cells(outrow, 2).Value = unittype
OutSH.Cells(outrow, 2).Font.Bold = True
OutSH.Cells(outrow + 1, 1).Value = unit
OutSH.Cells(outrow + 1, 3).Value = "Market Rent:"
OutSH.Cells(outrow + 1, 3).Font.Underline = True
OutSH.Cells(outrow + 1, 4).Value = mktrent
OutSH.Cells(outrow + 1, 5).Value = "Unit Status:"
OutSH.Cells(outrow + 1, 5).Font.Underline = True
OutSH.Cells(outrow + 1, 6).Value = unitstatus
OutSH.Cells(outrow + 1, 7).Value = "Date Ready:"
OutSH.Cells(outrow + 1, 7).Font.Underline = True
OutSH.Cells(outrow + 1, 8).Value = dateready
Cells(i, 1).Resize(15, 5).Copy Destination:=OutSH.Cells(outrow + 2, 1)
cntr = cntr + 1
If cntr = 2 Then
OutSH.HPageBreaks.Add Before:=OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
cntr = 0
End If
With OutSH.Cells(outrow + 1, 4).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With OutSH.Cells(outrow + 1, 6).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With OutSH.Cells(outrow + 1, 8).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
End If
Next i
OutSH.Columns("B:E").AutoFit
OutSH.Columns("F:F").ColumnWidth = 14.4
OutSH.Columns("G:H").AutoFit
OutSH.Columns("A:A").ColumnWidth = 14.25
OutSH.Rows("1:10000").RowHeight = 13.75
OutSH.PageSetup.Orientation = xlLandscape
OutSH.Columns("A:H").HorizontalAlignment = xlCenter
OutSH.Range("A1").HorizontalAlignment = xlLeft
End Sub
6 months ago someone here helped me build a macro to reformat a report. I own a property management company and I use this report to list my current vacancies. The way it is generated through my management software is very difficult to read and is poorly designed. After installing an update to the software it changed the look and cell placement of the report and so my macro will not work. I have tried changing the cell assignments for the variables but some of the coding was a little over my head. I have included the macro if anyone can help explain to me how it is worked Any help or advice would be greatly appreciated! Thank you!
-J
Sub aaa()
Dim OutSH As Worksheet
cntr = 0
Set OutSH = Sheets.Add(after:=Sheets(1))
ActiveSheet.Name = "Output"
OutSH.Range("A1").Value = "UNIT AVAILABILITY FOR RENT MAXIMIZER PRICING MODEL"
Range("G1").Formula = "=today()"
Sheets(1).Activate
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Left(Cells(i, 2), 5) = "Unit:" Then unit = Right(Cells(i, 4), Len(Cells(i, 1)) - 6)
If Left(Cells(i, 1), 10) = "Unit Type:" Then unittype = Right(Cells(i, 1), Len(Cells(i, 1)) - 11)
If Left(Cells(i, 1), 12) = "Market Rent:" Then mktrent = Right(Cells(i, 1), Len(Cells(i, 1)) - 13)
If Left(Cells(i, 1), 12) = "Unit Status:" Then unitstatus = Right(Cells(i, 1), Len(Cells(i, 1)) - 13)
If Left(Cells(i, 1), 11) = "Date Ready:" Then dateready = Right(Cells(i, 1), Len(Cells(i, 1)) - 12)
If Cells(i, 1) = "Lease Term" Then
outrow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Row
OutSH.Cells(outrow, 1).Value = "Unit Type:"
OutSH.Cells(outrow, 1).Font.Bold = True
OutSH.Cells(outrow, 2).Value = unittype
OutSH.Cells(outrow, 2).Font.Bold = True
OutSH.Cells(outrow + 1, 1).Value = unit
OutSH.Cells(outrow + 1, 3).Value = "Market Rent:"
OutSH.Cells(outrow + 1, 3).Font.Underline = True
OutSH.Cells(outrow + 1, 4).Value = mktrent
OutSH.Cells(outrow + 1, 5).Value = "Unit Status:"
OutSH.Cells(outrow + 1, 5).Font.Underline = True
OutSH.Cells(outrow + 1, 6).Value = unitstatus
OutSH.Cells(outrow + 1, 7).Value = "Date Ready:"
OutSH.Cells(outrow + 1, 7).Font.Underline = True
OutSH.Cells(outrow + 1, 8).Value = dateready
Cells(i, 1).Resize(15, 5).Copy Destination:=OutSH.Cells(outrow + 2, 1)
cntr = cntr + 1
If cntr = 2 Then
OutSH.HPageBreaks.Add Before:=OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
cntr = 0
End If
With OutSH.Cells(outrow + 1, 4).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With OutSH.Cells(outrow + 1, 6).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With OutSH.Cells(outrow + 1, 8).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
End If
Next i
OutSH.Columns("B:E").AutoFit
OutSH.Columns("F:F").ColumnWidth = 14.4
OutSH.Columns("G:H").AutoFit
OutSH.Columns("A:A").ColumnWidth = 14.25
OutSH.Rows("1:10000").RowHeight = 13.75
OutSH.PageSetup.Orientation = xlLandscape
OutSH.Columns("A:H").HorizontalAlignment = xlCenter
OutSH.Range("A1").HorizontalAlignment = xlLeft
End Sub