PDA

View Full Version : Solved: Divide column based upon character count



HealdsburgCA
09-12-2012, 08:33 AM
Howdy all,


Howdy all,

I have created an Access database and am ready to import data stored inExcel worksheets. I found the macro I need to combine the worksheets into asingle work sheet. The problem I have is that the character count in the"subject" column ranges from 100-700 characters but a text field inAccess is only 255 characters. Memo fields are not an option. To overcome thisin Access I have created multiple text fields (Subject1, Subject2, Subject3,etc.) to contain the data. But I need to get the Excel data formatted for animport.

I am still a bit green in the VBA/Macro world and I would appreciate somehelp in finding some code to take the "subject" column (column B) andbreak it up into multiple columns based on the # of characters.

i.e new column F = Characters 1-255 from Column B; new column G = Characters256-510 from Column B; etc.

It would be great if the code had the option of ensuring that a word isn’tsplit between columns, (meaning if the 255th character landed in the middle of “municipality”Column F wouldn’t end with “munici” and Column G begin with “pality”). Instead the full word would get pushed intoColumn G.

Any thoughts or ideas are greatly appreciated!

-Joshua

GTO
09-12-2012, 01:26 PM
Greetings Joshua and welcome to vbaexpress :-)

Barely tested; in a junk copy of your wb...

In a Standard Module:
Option Explicit

Sub example()
Dim lStripLen As Long
Dim lOffset As Long
Dim strRaw As String
Dim strTemp As String
Dim Cell As Range

With Sheet1 '<---CodeName of sheet we are running against
For Each Cell In .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
strRaw = vbNullString
strRaw = Cell.Value
If Len(strRaw) > 0 Then
If Len(strRaw) < 256 Then
Cell.Offset(, 4).Value = strRaw
Else
lOffset = 3
Do While Len(strRaw) > 255
lStripLen = 255
strTemp = Left(strRaw, lStripLen)
Do While Not Mid(strTemp, lStripLen, 1) = Chr(32)
lStripLen = lStripLen - 1
Loop
strTemp = Left(strRaw, lStripLen)
strRaw = Mid(strRaw, lStripLen + 1)
lOffset = lOffset + 1
Cell.Offset(, lOffset).Value = strTemp
Loop
If Len(strRaw) > 0 Then
Cell.Offset(, lOffset + 1).Value = strRaw
End If
End If
End If
Next
End With
End Sub
Hope that helps,

Mark

HealdsburgCA
09-12-2012, 01:55 PM
Mark,
Thank you for the code, it worked perfectly!

I'm trying to grow in my understanding of VBA, quick questions:

Which part of the code tells Excel to not split a word between cells?

Also what does "Do While" and "Loop" cause to happen? What do these phrases mean?

Thanks again!

-Joshua

PS Being new to these forums, is there a way to mark this question as solved?

GTO
09-12-2012, 05:22 PM
You are most welcome and glad that helped. You'll want to search for 'Do...Loop' or similar in VBA help. Here is the code commented a bit.
Sub example()
Dim lStripLen As Long
Dim lOffset As Long
Dim strRaw As String
Dim strTemp As String
Dim Cell As Range

With Sheet1 '<---CodeName of sheet we are running against
For Each Cell In .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
strRaw = vbNullString
strRaw = Cell.Value
If Len(strRaw) > 0 Then
'// If the length of the string in the cell is less than 256 //
'// characters ('char' hereafter) (including non-printing //
'// characters), then just plunk the value in col F //
If Len(strRaw) < 256 Then
Cell.Offset(, 4).Value = strRaw
Else
lOffset = 3
'// Here we loop as long as (While) some test is True. //
Do While Len(strRaw) > 255
lStripLen = 255
'// Take the leftmost 255 chars of our big string and //
'// put it in a temp string. //
strTemp = Left(strRaw, lStripLen)
'// Loop as long as the char being checked is NOT a //
'// space. Once a space is found at a position, save //
'// the position in lStripLen and use this to parse. //
Do While Not Mid(strTemp, lStripLen, 1) = Chr(32)
lStripLen = lStripLen - 1
Loop
strTemp = Left(strRaw, lStripLen)
strRaw = Mid(strRaw, lStripLen + 1)
lOffset = lOffset + 1
Cell.Offset(, lOffset).Value = strTemp
Loop
If Len(strRaw) > 0 Then
Cell.Offset(, lOffset + 1).Value = strRaw
End If
End If
End If
Next
End With
End Sub

HealdsburgCA
09-13-2012, 10:20 AM
Thank you for the comments!