EXCEL SPLIT CELLS INTO NEIGHBORING CODE
Make the changes to the Worksheet references in the code (only need to do that at the beginning of the regular module. RRes.Rows(I + 1).Font.Color = colOC(I).FontColor Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2)) 'Clear the results worksheet and write the results 'Will need to add entries for the other columns 'Copy the column headings from the source ReDim vRes(0 To colOC.Count, 1 To UBound(vSrc, 2)) 'Will need to adjust for the extra columns 'Iterate through each SESE_ID, picking up the SEPY_PFX, and RULE Value, vSEPY(J), vbTextCompare), 1).Font.Color 'Get the font color from the original cell Set colOC = New Collection 'Collection of each "to be" row Then, in a regular module: Option Explicitĭim wsSrc As Worksheet, wsRes As Worksheet Public Property Let SESE(Value As String) Public Property Let Rule(Value As String) Public Property Let FontColor(Value As Long) Public Property Let SEPY(Value As String) With regard to the use of classes, please see Chip Pearson's web siteĪlso, please read the comments in the code for explanations and suggestions.įirst insert a Class Module, ReNAME it cOfcCode and paste the code below into it: 'Will need to add properties for the additional columns You should be able to adapt it to your real data, but, if you cannot, I suggest you post a "sanitized" copy of your original data, with the correct columns and so forth, on some file sharing web site such as DropBox, OneDrive, etc and post a link here so we can see the "real stuff" In your original you had some font coloring, which I have carried over. I use arrays to collect and output the data, because this will work much faster. It works by using Class and Collections, creating each entry one at a time, and then putting it together for the results. This code will work on the first example you posted to give the output you wanted: Currently my code gave me RULE as SEPY_PFX, I am still working on it BUT it will be glad if someone help me on this quickly, it is already going above my head. I wanted every row to be repeated for each SEPY. Problem: If you see the source data, I have SEPY_PFX in column A. MsgBox "All set, make sure there is no #N/A in SESE_RULE column" Text1 = s2.Cells(rw, 1) & " row: " & rw 'seseĭim wss, wsSepy, wsSID As Worksheet 'SID = Serivce ID Spreadsheetĭim sepyRow, sep圜ol, acctCol, sidSeseCol, sidAcctCol, j As Long S2.Cells(rw, col1).Offset(0, ar).Value = s2.Cells(rwcw, w).Value 'obtain rule and write to alt rule column of current row If InStr(1, s2.Cells(rwcw, y).Value, xwalk, vbTextCompare) > 0 Then 'use crosswalk service id to populate alt rule TOSes = Split(s2.Cells(rw, y).Value, Chr(10)) 'Chr(10) is the "new line" characterįor col1 = w To s2. 'change rw = z + 2 to rw = z, was skipping first two rowsįor rw = z To s2.Range("a65536").End(xlUp).Row Loop Until Left(s2.Cells(1, ar).Value, 3) = "Alt" 'counts # of cells between "rule" and "alt rule", used as precedent for rest of "alt rule" cells 'Alt rule column (location derived from rule column) Loop Until Left(s2.Cells(1, cw).Value, 9) = "Crosswalk" Loop Until Left(s2.Cells(1, w), 4) = "Rule" S1.Range("L:L").NumberFormat = "m/d/yyyy" S1.Range("C:C").NumberFormat = "m/d/yyyy" S1.Range("A:A").NumberFormat = "m/d/yyyy" If ws.Name = "CMC_SEPY_SE_PYMT" Then Sheets("CMC_SEPY_SE_PYMT").Delete