How to Loop through column, identify cells with data, and set string length

I've pasted a portion of the code I've created to set the string length on specific cells, what I was hoping to find is a more efficient way to loop through the data. The problem I have is that the cells that need to have the string length set are separated by a variable amount of blank cells.

The existing workbook has 7 fields that need the set length of characters, but future ones will require many more. The cells that require a set length also have data occupying the F column. I'm unsure how that could be used to identify which cells need the set string length.

Sub SetStringLength()

Dim x As Integer

Worksheets("Sheet1").Activate

q = Worksheets("Sheet1").Range("D7").Text
x = Len(Worksheets("Sheet1").Range("D7").Text)
q = q & String(24 - x, " ")
Worksheets("Sheet1").Range("D7") = q

q = Worksheets("Sheet1").Range("D18").Text
x = Len(Worksheets("Sheet1").Range("D18").Text)
q = q & String(8 - x, " ")
Worksheets("Sheet1").Range("D18") = q

End Sub

Open in new window


Thanks!
K_R_MAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

EmenizerCommented:
This code should do fine.
-->loop through a range of cells
-->set string length for all non empty cells

The string length is however fixed. You could only make this variable if you build in some logic for that (either pick it up from other cells or have some logic in vba which defines the string length you want)
Sub SetStringLength()

Dim rngRange As Range
Dim rngCell As Range
Dim lngStringLength As Long

lngStringLength = 24

'define range to set string lengths
Set rngRange = Worksheets("Sheet1").Range("D7:D18")

'loop through cell of range and set string length if not empty
For Each rngCell In rngRange
    If rngCell.Value <> Empty Then
        rngCell = SetString(rngCell.Text, lngStringLength)
    End If
Next rngCell


End Sub

Function SetString(ByVal cellValue As String, ByRef preferedCellLength As Long) As String
    Dim cellValueLength As Long
    cellValueLength = Len(cellValue)
    SetString = cellValue & String(preferedCellLength - cellValueLength, " ")
End Function

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Eoin RyanI.T. ContractorCommented:
You'll have to get more specific. From the code you've posted to seem to be making D7, 24 characters long, while D18, 8 characters long.
What are the "rules" you want to specify?

as for looing through your sheet I generally use "usedrange.rows.count" and "usedrange.columns.count" to find how long and wide the used space is on the sheet, then use a for loop to go through each cell.

lastly, if this is moderately complicated scenario 125 points may not get your many responses, as evidenced so far.
0
K_R_MAuthor Commented:
Emenizer,
Your code worked out very well, I hadn't realized I included the 24 char. long set length; that was the outlier for the work, all the remainders are 8

EoDawg,
In retrospect, the point value I assigned was definitely low. I see now that I can increase the value only through commenting, and have done such.

Thank you both for your help!
0
Eoin RyanI.T. ContractorCommented:
Hi, Didn't mean to come across cranky ;) Just from your code there seemed there may be more to what you needed, and it had the potential to get more complex.

glad you got a solution.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.