PDA

View Full Version : Transpose Script not copying one specific field



GrizzlyBear
03-14-2015, 09:28 PM
Hey guys,

Recently wrote this VBA script for an excel spreadsheet that transposes the value in column E based on the values in columns A, C, and D. It works great except when it outputs the organized sheet it fails to pull the address field for whatever reason.

Heres my code:



Option Explicit




Sub My_Organize()
Dim rw As Long, v As Long, vHDRs As Variant
Dim i As Long, j As Long, iREFNO As Long, iREFROW As Long, iLR As Long
Dim ws As Worksheet, app As Application


Set app = Application
app.ScreenUpdating = False
app.EnableEvents = False
app.DisplayAlerts = False
app.Calculation = xlCalculationManual


On Error Resume Next
Worksheets("Organized").Delete
On Error GoTo Safe_Exit
Worksheets.Add(after:=Sheets(Sheets.Count)).Name = "Organized"
Set ws = Sheets(Sheets.Count)


vHDRs = Array(Array("Reference #", -1, -2), _
Array("Provider Name", 300, 100), _
Array("Provider Number", 300, 300), _
Array("County", 200, 400), _
Array("Address", 100, 100), _
Array("Zip", 200, 300))


ws.Cells(1, 1).Resize(1, UBound(vHDRs) + 1) = app.Transpose(app.Index(vHDRs, , 1))


With Sheet1
iLR = .Cells(Rows.Count, 1).End(xlUp).Row
With .Cells(1, 1).CurrentRegion
.Cells.Sort Key1:=.Columns(1), Order1:=xlAscending, _
Key2:=.Columns(3), Order2:=xlAscending, _
Key3:=.Columns(4), Order3:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlYes


For rw = 2 To iLR
If iREFNO <> .Cells(rw, 1).Value2 Then
If Not CBool(app.CountIf(ws.Columns(1), .Cells(rw, 1).Value2)) Then
iREFNO = .Cells(rw, 1).Value2
iREFROW = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Cells(iREFROW, 1) = iREFNO
End If
Else
For i = LBound(vHDRs, 1) To UBound(vHDRs, 1)
If .Cells(rw, 3).Value2 = vHDRs(i)(1) And _
.Cells(rw, 4).Value2 = vHDRs(i)(2) Then
ws.Cells(iREFROW, i + 1) = .Cells(rw, 5).Value2
Exit For
End If
Next i
End If
Next rw
End With
End With


Safe_Exit:
Set ws = Nothing
app.Calculation = xlCalculationAutomatic
app.DisplayAlerts = True
app.EnableEvents = True
app.ScreenUpdating = True
Set app = Nothing
End Sub




And here is a screenshot of the before and after -->

Before:13011

After: 13012

Why is this happening to me? The address field is the only field in the entire document that will not populate whatsoever. I'm really banging my head against the wall here.

Thank you for taking the time to look at my script. Hopefully we can come to a solution :)