Reconfiguring variable assignments

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


 

Attachments

  • Unit Pricing Template.xlsm
    401.3 KB · Views: 23
I'm crafty enough with VBA to play with the formatting. Would you mind if I took a look at what you got? Thanks again for helping me, I appreciate it.

-J
 
On your instruction sheet the copying and pasting the original data back over itself is something I'm just not comfortable with. I don't like destroying original data, so this macro creates a copy of the "Raw Data" sheet to work with, then deletes the copy at the end.

Changed the date going to the top of the "Output" sheet to be a written string. If for some reason you open this "Output" sheet a month or year from now this date will indicate when the data was current as opposed to being the current date with old data.

I believe this does what you requested. Some further formatting and tweaking will probably be necessary to meet your exact requirements.

Good Luck with your project
NoS
 

Attachments

  • Altered Unit Pricing.xls
    143 KB · Views: 18
Back
Top