Parsing text

[notarypublic]

Hello,

I'm working on a project that has data grouped first by one attribute, and then another: There are three tractors using a 335 HP engine, and each of them has their own column.

I've been working on a macro to condense those three columns into a single column, with the format as follows: "NH 335: N57-M24, N57-P16, N57-P16HD"

I'm trying to copy the data all into a new worksheet to make it easier to work with. I haven't worked with variable amounts of columns before (While a 335 HP engine has 3 models, a 440 HP engine could go in 5) which is what I think is causing the problem. Here's the macro I've written so far:

Sub quickParse()
On Error GoTo oops
Dim partRangeStart As String, engineHP As String, columnOutput As String
Dim partRange As Integer
Dim i As Integer, j As Integer

engineHP = InputBox(prompt:="What tractor model is being condensed?", Title:="tractor model", Default:="NH 335")
partRangeStart = InputBox(prompt:="Please enter a Column to start condensing:", Title:="Engine HP", _
                Default:="A")
partRange = InputBox(prompt:="How many columns are to be condensed?", Title:="How many models are in this series?", _
                Default:="1")
columnOutput = InputBox(prompt:="Select a column to output to", Title:="Column to output to:", _
                Default:="A")

                
'i is the loop for all the parts in the spreadsheet, j is the loop for the column range for each model series
i = 3

Do
    Worksheets("PartList").Range("A" & i).Value = Worksheets("temp").Range("A" & i).Value
    Worksheets("PartList").Range("B" & i).Value = Worksheets("temp").Range("B" & i).Value
    'runs through the column range
    j = 0
    Worksheets("PartList").Range(columnOutput, i).Value = engineHP & ": "
    Do
        If Worksheets("temp").Range(partRangeStart + j, i).Value <> "" Then
                Worksheets("PartList").Range(columnOutput, i).Value = Worksheets("PartList").Range(columnOutput, i).Value _
                + Worksheets("temp").Range(partRangeStart + j, i).Value & ", "
        End If
    Loop Until j = partRange - 1
    
i = i + 1
Loop Until Worksheets("temp").Range("A" & i).Value = ""

oops:
End Sub

This populates a field with a part number, and another with a part description. It should then output a string similar to the desired one, but it hasn't output any results to speak of.

Any ideas?

 

[craig.penny]

I can't see where j gets incremented. Is this loop behaving how you want? Have you tried stepping through using F8?

    Do
        If Worksheets("temp").Range(partRangeStart + j, i).Value <> "" Then
                Worksheets("PartList").Range(columnOutput, i).Value = Worksheets("PartList").Range(columnOutput, i).Value _
                + Worksheets("temp").Range(partRangeStart + j, i).Value & ", "
        End If
    Loop Until j = partRange - 1

 

[notarypublic]

That is one of the issues, but I found enough other errors with the way I was going about this sub that I decided to start from scratch. The general flow of the sub should run as follows..

'Initialize variables
 
'Input prompts asking for the Engine HP, the first column to 
'start parsing/condensing text from, how many columns to check,
'and which column of a new worksheet to export the string to.
 
'The macro then goes across columns of the specified width. If there are 
'only blank cells, it leaves the cell of the column in the new worksheet
'blank. If there are values, it creates a string containing the Engine HP
'followed by the values of the cells inside that range. 
 
'It keeps going through this process until it runs through all the records.

Is one of the issues possibly that I was prompting the user for a column to start, "A" for example, and then using it as a numerical value later? Is it wrong to treat it in code as "A + 1" or "A + 3" to indicate values in columns B and D?

 

[craig.penny]

I could see how that would cause problems. You know you can refer to columns by number too? Like:

 Cells(2,3)

Would be the cell in the 2nd row and 3rd column a.k.a "C2".

Columns(4).Select

Will select column "D", and so on.

Personally, I find it easier to think of it that way and then the math makes more sense to me.

When you get the code rewritten why don't you post it back up here, if it doesn't do what you want.

 

[notarypublic]

Referring to the columns by numbers would be easier from a coding standpoint, but the table I am working with has columns as far as CT and am writing the tool for people less computer oriented than myself..

Someone pointed me towards a fix using the offset property, which seems to work ok. It's not ideal, but honestly excel really isn't the proper tool for a job of this magnitude. I'm just working with the tools that I have..

 

[notarypublic]

In case anyone ever has a similar problem, here's my working solution:

Sub quickParse()

Dim inputCol As String, outputCol
Dim rangeCol As Integer, i As Integer, j As Integer

' this boolean is so that rows without values are skipped
Dim isEmpty As Boolean
 
'sets a column to start working with, a range of cells to parse, and a column to output the text to
inputCol = InputBox(prompt:="Input a column")
rangeCol = InputBox(prompt:="Input a range")
outputCol = InputBox(prompt:="Output Column?")
i = 1
 
Do
    On Error GoTo oops
    isEmpty = True
    
    j = 0
    
    Do
        If Worksheets("Sheet1").Range(inputCol & i).Offset(0, j).Value <> "" Then
            isEmpty = False
        End If
        j = j + 1
    Loop Until j = rangeCol
    
    j = 0
    
    If isEmpty = False Then
    Do
       If j = 0 Then
        Worksheets("Sheet1").Range(outputCol & i).Value = "NH 335: "
       End If
       
       If Worksheets("Sheet1").Range(inputCol & i).Offset(0, j).Value <> "" Then
                Worksheets("Sheet1").Range(outputCol & i).Value _
                = Worksheets("Sheet1").Range(outputCol & i).Value & _
                Worksheets("Sheet1").Range(inputCol & i).Offset(0, j).Value & ", "
       End If
       
       j = j + 1
    Loop Until j = rangeCol
    
     'Trims the last space and comma from the last item in the range
       Worksheets("Sheet1").Range(outputCol & i).Value = _
       Left(Worksheets("Sheet1").Range(outputCol & i).Value, _
       Len(Worksheets("Sheet1").Range(outputCol & i).Value) - 2)
    
    End If
    
    i = i + 1
Loop Until Worksheets("Sheet1").Range("A" & i).Value = ""
oops:
End Sub