Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Excel - amend script to include column G

Posted on 2016-08-29
9
Medium Priority
?
67 Views
Last Modified: 2016-08-29
The attached files contain table and a script that re-arranges the data into a different table in a new worksheet called Result.
The script omits column G "size",  when it moves data from the original table.
Many cells under Column G do not have a value, but where there is a value, I would like it to be included in its own column in the Result worksheet.
Example-Excel-file---size-column-re.xlsm
0
Comment
Question by:gregfthompson
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 2
  • 2
  • +2
9 Comments
 
LVL 18

Expert Comment

by:xtermie
ID: 41774373
hi greg, cant see the script in the macro sheet of the attached example
Could you please post the script so we can make amendments as you describe?
0
 
LVL 22

Expert Comment

by:Roy Cox
ID: 41774395
There is no code within the workbook to edit.

Also, the data is very poorly laid out to work with.

I would suggest that you attach an example with the data and macro in and an additional sheet showing what the end result should be.
0
 

Author Comment

by:gregfthompson
ID: 41774401
Sorry for mucking you about.
My error. More haste, less speed at my end.

The attached file includes a Results example worksheet that includes the required Size column.
If you run the script you will see how the original table is parsed into the more usable Results worksheet.
Example-Excel-file---size-column-re.xlsm
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 53

Expert Comment

by:Rgonzo1971
ID: 41774415
Hi,

pls try

Option Explicit

Sub Transpose_Listings()
    Dim rng As Range
    Dim cl As Range
    Dim strAddress As String, strSub As String, strType As String, strMonth As String, strSize As String
    Dim intBed As Integer, intBath As Integer, intCar As Integer, intYear As Integer
    Dim v As Variant, varPrice As Variant
    Dim intRow As Long

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Set rng = Worksheets(1).Range("A2:A" & Worksheets(1).Cells.SpecialCells(xlLastCell).Row)

    On Error Resume Next
    Sheets("Results").Delete
    On Error GoTo 0
    Sheets.Add After:=Sheets(1)
    ActiveSheet.Name = "Results"
    Range("A1").Value = "Address"
    Range("B1").Value = "Suburb"
    Range("C1").Value = "Bed"
    Range("D1").Value = "Bath"
    Range("E1").Value = "Car"
    Range("F1").Value = "Type"
    Range("G1").Value = "Month"
    Range("H1").Value = "Year"
    Range("I1").Value = "Price"
    Range("J1").Value = "Size"
    intRow = 2

    For Each cl In rng
        Select Case LCase(cl.Value)
        Case "address"    'start of data block
            'skip
        Case "date and price list"
            'skip
        Case "date"
            'skip
        Case ""
            'skip
        Case Else
            If IsDate(cl.Value) Then            'pricing data - write to Results sheet
                v = CDate(cl.Value)
                strMonth = Format(v, "mmmm")
                intYear = Year(v)
                If InStr(1, cl.Offset(0, 1).Value, " ") = 0 Then
                    varPrice = cl.Offset(0, 1).Value
                Else
                    varPrice = Val(Mid(cl.Offset(0, 1).Value, 2, InStr(1, cl.Offset(0, 1).Value, " ") - 1))
                End If
                With Sheets("Results")
                    .Cells(intRow, 1) = strAddress
                    .Cells(intRow, 2) = strSub
                    .Cells(intRow, 3) = intBed
                    .Cells(intRow, 4) = intBath
                    .Cells(intRow, 5) = intCar
                    .Cells(intRow, 6) = strType
                    .Cells(intRow, 7) = strMonth
                    .Cells(intRow, 8) = intYear
                    .Cells(intRow, 9) = varPrice
                    .Cells(intRow, 10) = strSize
                End With
                intRow = intRow + 1
            Else
                intBed = 0
                intBath = 0
                intCar = 0
                strAddress = Left(cl.Value, InStr(1, cl.Value, ",") - 1)
                strSub = Mid(cl.Value, InStr(1, cl.Value, ",") + 2)
                If cl.Offset(0, 1).Value <> "" Then intBed = Right(cl.Offset(, 1).Value, (Len(cl.Offset(, 1).Value) - InStr(cl.Offset(, 1).Value, ":")))
                If cl.Offset(0, 2).Value <> "" Then intBath = Right(cl.Offset(, 2).Value, (Len(cl.Offset(, 2).Value) - InStr(cl.Offset(, 2).Value, ":")))
                If cl.Offset(0, 3).Value <> "" Then intCar = Right(cl.Offset(, 3).Value, (Len(cl.Offset(, 3).Value) - InStr(cl.Offset(, 3).Value, ":")))
                strType = cl.Offset(0, 4).Value
                strSize = cl.Offset(0, 6).Value
    
            End If
        End Select
    Next cl

    With Sheets("Results")
        .Range("A:G").EntireColumn.AutoFit
        .Range("I2:I" & intRow).NumberFormat = "$#,##0"
    End With

    RemoveDuplicates

    Application.DisplayAlerts = True
    MsgBox "Done."
End Sub

Private Sub RemoveDuplicates()
    Application.CutCopyMode = False
    Worksheets("Results").UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), Header:=xlYes
End Sub

Open in new window

Regards
0
 

Author Comment

by:gregfthompson
ID: 41774418
Thanks.

It would not run. Window said "Invalid outside procedure"
0
 
LVL 22

Expert Comment

by:Roy Cox
ID: 41774423
Are the size results in the correct rows?
0
 
LVL 53

Accepted Solution

by:
Rgonzo1971 earned 2000 total points
ID: 41774428
0
 
LVL 33

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41774437
Try this......

Sub Transpose_Listings()
    Dim rng As Range
    Dim cl As Range
    Dim strAddress As String, strSub As String, strType As String, strMonth As String
    Dim intBed As Integer, intBath As Integer, intCar As Integer, intYear As Integer, varSize As String
    Dim v As Variant, varPrice As Variant
    Dim intRow As Long

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Set rng = Worksheets(1).Range("A2:A" & Worksheets(1).Cells.SpecialCells(xlLastCell).Row)

    On Error Resume Next
    Sheets("Results").Delete
    On Error GoTo 0
    Sheets.Add After:=Sheets(1)
    ActiveSheet.Name = "Results"
    Range("A1").Value = "Address"
    Range("B1").Value = "Suburb"
    Range("C1").Value = "Bed"
    Range("D1").Value = "Bath"
    Range("E1").Value = "Car"
    Range("F1").Value = "Type"
    Range("G1").Value = "Month"
    Range("H1").Value = "Year"
    Range("I1").Value = "Price"
    Range("J1").Value = "Size"
    intRow = 2

    For Each cl In rng
        DoEvents
        Select Case LCase(cl.Value)
        Case "address"    'start of data block
            'skip
        Case "date and price list"
            'skip
        Case "date"
            'skip
        Case ""
            'skip
        Case Else
            If IsDate(cl.Value) Then            'pricing data - write to Results sheet
                v = CDate(cl.Value)
                strMonth = Format(v, "mmmm")
                intYear = Year(v)
                If InStr(1, cl.Offset(0, 1).Value, " ") = 0 Then
                    varPrice = cl.Offset(0, 1).Value
                Else
                    varPrice = Val(Mid(cl.Offset(0, 1).Value, 2, InStr(1, cl.Offset(0, 1).Value, " ") - 1))
                End If
                With Sheets("Results")
                    .Cells(intRow, 1) = strAddress
                    .Cells(intRow, 2) = strSub
                    .Cells(intRow, 3) = intBed
                    .Cells(intRow, 4) = intBath
                    .Cells(intRow, 5) = intCar
                    .Cells(intRow, 6) = strType
                    .Cells(intRow, 7) = strMonth
                    .Cells(intRow, 8) = intYear
                    .Cells(intRow, 9) = varPrice
                    .Cells(intRow, 10) = varSize
                End With
                intRow = intRow + 1
            Else
                intBed = 0
                intBath = 0
                intCar = 0
                strAddress = Left(cl.Value, InStr(1, cl.Value, ",") - 1)
                strSub = Mid(cl.Value, InStr(1, cl.Value, ",") + 2)
                If cl.Offset(0, 1).Value <> "" Then intBed = Right(cl.Offset(, 1).Value, (Len(cl.Offset(, 1).Value) - InStr(cl.Offset(, 1).Value, ":")))
                If cl.Offset(0, 2).Value <> "" Then intBath = Right(cl.Offset(, 2).Value, (Len(cl.Offset(, 2).Value) - InStr(cl.Offset(, 2).Value, ":")))
                If cl.Offset(0, 3).Value <> "" Then intCar = Right(cl.Offset(, 3).Value, (Len(cl.Offset(, 3).Value) - InStr(cl.Offset(, 3).Value, ":")))
                strType = cl.Offset(0, 4).Value
                varSize = cl.Offset(0, 6).Value
            End If
        End Select
    Next cl

    With Sheets("Results")
        .Range("A:G").EntireColumn.AutoFit
        .Range("I2:I" & intRow).NumberFormat = "$#,##0"
    End With

    RemoveDuplicates

    Application.DisplayAlerts = True
    MsgBox "Done."
End Sub

Private Sub RemoveDuplicates()
    Application.CutCopyMode = False
    Worksheets("Results").UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9), Header:=xlYes
End Sub

Open in new window

0
 

Author Closing Comment

by:gregfthompson
ID: 41774511
Thanks. That works perfectly.
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how you can use Custom Document Properties to store settings and other information in your workbook so that they will be available the next time you open the workbook.
If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

610 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question