Need to combine information from two different worksheets on new worksheet

evisu18 · Apr 11, 2013

Hello,

Let's say I have

Sheet1 with a column that has a list of colors and Sheet2 has a 4 row x 4 column template with quantities and articles of clothing.

I need my macro to

1. Generate Sheet3 and fill in Row 1 with these column names: "T-shirts" , "Sweaters", "Jackets", and "Pants". (This step can be skipped, but it is preferred)

2. Copy and paste the template from Sheet2 to Sheet3.
3. Find and Replace 'Blank' with the color column starting with the first. 'Red', 'Yellow', 'Orange'. and so on.

4. Macro ends when it reaches a blank value on the color column.

Attached images of screenshots for further clarification.

Thank you for stopping by and your help is very much appreciated!

Also posted on another forum

Need to combine information from two different worksheets on new worksheet

sijpie · Apr 11, 2013

I've got a neat very flexible solution, but needs a little bit more work. Hope to post it tomorrow(European time)

sijpie · Apr 12, 2013

try this code. It is quite flexible in that it isn't restricted to the number of colours or the number of types of clothing or sizes. And don't blink, it is very fast.

Code:

Option Explicit


Sub CreateClothingOptions()
    Const DELIM = "'Blank'"       '  'Blank' will be replaced by colours
    Dim wsCnS As Worksheet, wsC As Worksheet, wsNL As Worksheet
    Dim rCol As Range, rTempl As Range, rOutp As Range
    Dim arCloth As Variant, arCol As Variant, arNewL As Variant
    Dim j As Long, i As Long, k As Long, lCol As Long, lSize As Long, lTypes As Long
    
    On Error GoTo MisSheet
        Set wsCnS = Sheets("Colors and stuff")
        Set wsC = Sheets("Clothes")
        Set wsNL = Worksheets.Add(After:=wsC)
   '     wsNL.Name = "NewList"
    On Error GoTo 0
    
    Set rCol = wsCnS.[B2]
    Set rTempl = wsC.[A1]
    Set rOutp = wsNL.[A1]
    
    'dimension our working array
    lSize = rTempl.CurrentRegion.Rows.Count
    lTypes = rTempl.CurrentRegion.Columns.Count
    lCol = rCol.CurrentRegion.Rows.Count - 1
    ReDim arNewL(0 To lSize * lCol, 1 To lTypes) 'row 0 for the headers
    
    arCloth = rTempl.CurrentRegion
    arCol = rCol.Resize(lCol, 1)
    
    ' create the headers and add in row 0
    For i = 1 To lTypes
        arNewL(0, i) = GetType(CStr(arCloth(1, i)), DELIM)
    Next i
    
    For i = 1 To lCol
        For j = 1 To lSize
            For k = 1 To lTypes
                arNewL(j + (i - 1) * lSize, k) = Application.WorksheetFunction.Substitute( _
                CStr(arCloth(j, k)), DELIM, CStr(arCol(i, 1)))
                    'SUBSTITUTE(Text,Old_Text,New_Text)
            Next k
        Next j
    Next i
    rOutp.Resize(lSize * lCol + 1, lTypes).Value = arNewL
    Exit Sub
MisSheet:
    MsgBox "Sheets missing or output sheet already exists"
End Sub


Function GetType(sInp As String, sDel As String) As String
    Dim i As Integer, sRes As String
    
    i = InStr(1, sInp, sDel)
    sRes = Right(sInp, Len(sInp) - i - Len(sDel))
    
    GetType = sRes
End Function

evisu18 · Apr 12, 2013

Very impressive! I have only started with visual basic recently, but have never seen code like that. It looks interesting and it is definitely neat. Thank you so much!
But now I have another problem. I changed the first column called “Code” with code numbers to match the colors.

The output sheet then has a “Code” column with the code matching the items in each row. It should look like this:

Any help will be appreciated. Thanks in advance.

sijpie · Apr 12, 2013

By working in arrays you can do input and output to the sheet real quick. No slow copy pasting, no individual reads or writes. Just load a whole range into an array, do all your calcs in an array and the write an array back to a range.

here independent on how many colours, clothes and sizes you have, there are only two read accesses and one write access to the sheet.

Option Explicit Sub CreateClothingOptions() Const DELIM = "'Blank'" ' 'Blank' will be replaced by colours Dim wsCnS As Worksheet, wsC As Worksheet, wsNL As Worksheet Dim rCol As Range, rTempl As Range, rOutp As Range Dim arCloth As Variant, arCol As Variant, arNewL As Variant Dim j As Long, i As Long, k As Long, lCol As Long, lSize As Long, lTypes As Long On Error GoTo MisSheet Set wsCnS = Sheets("Colors and stuff") Set wsC = Sheets("Clothes") Set wsNL = Worksheets.Add(After:=wsC) ' wsNL.Name = "NewList" On Error GoTo 0 Set rCol = wsCnS.[A2] Set rTempl = wsC.[A1] Set rOutp = wsNL.[A1] 'dimension our working array lSize = rTempl.CurrentRegion.Rows.Count lTypes = rTempl.CurrentRegion.Columns.Count lCol = rCol.CurrentRegion.Rows.Count - 1 ReDim arNewL(0 To lSize * lCol, 1 To lTypes + 1) 'row 0 for the headers arCloth = rTempl.CurrentRegion arCol = rCol.Resize(lCol, 2) 'code & color ' create the headers and add in row 0 For i = 1 To lTypes arNewL(0, i) = GetType(CStr(arCloth(1, i)), DELIM) Next i arNewL(0, i) = "ColCode" For i = 1 To lCol For j = 1 To lSize For k = 1 To lTypes arNewL(j + (i - 1) * lSize, k) = Application.WorksheetFunction.Substitute( _ CStr(arCloth(j, k)), DELIM, CStr(arCol(i, 2))) 'SUBSTITUTE(Text,Old_Text,New_Text) Next k arNewL(j + (i - 1) * lSize, k) = arCol(i, 1) Next j Next i rOutp.Resize(lSize * lCol + 1, lTypes + 1).Value = arNewL Exit Sub MisSheet: MsgBox "Sheets missing or output sheet already exists" End Sub Function GetType(sInp As String, sDel As String) As String Dim i As Integer, sRes As String i = InStr(1, sInp, sDel) sRes = Right(sInp, Len(sInp) - i - Len(sDel)) GetType = sRes End Function

sijpie · Apr 23, 2013

From Private Message:

evisu18 said:
Thank you very much for the help with the Macro. It is very neat and I have actually never seen this method used before. But now I have another problem. Instead of the cell values like 10 'Blank' Sweaters, it will have formulas like ='Blank'!$A$1 or ='Blank'!$D$9-'Blank'!$F$9. But the problem is I do not want Excel to try to calculate the formulas, I only want the equations to have the 'Blank' replaced. Do you know how to fix it? I would be very grateful for you help.

Thanks!

Do you also have sheets for each of the colours? I mean if we were to replace the formula
='Blank'!$A$1 with
='Red'!$A$1
would that result in an error, or is that what you want to achieve?

sijpie · Apr 23, 2013

It will help if you can either post a sample spreadsheet somewhere (dropbox or so) or use ExcelGenie to post exactly what is in the various sheets and formulas, else i will be chasing my tail here.

evisu18 · May 17, 2013

Hello,

Sorry I was away for a while so I did not see your post.

This was the problem that I was trying to solve.

From this Worksheet "Name List",

1. The values in the "New Name" column will be used to replace the 'BLANK' fields in the next worksheet which is called "Template".
2. The corresponding "Code Name" should be filled in the "Template" worksheet

This is a sample with the first two sets filled in. The Equations should not compute, it will be used later for Google Docs. The "New Name" values will actually be names of worksheets in which Google Doc will derive values from.

I uploaded a sample on Dropbox here

https://www.dropbox.com/s/dnrxy7bhk1zh3i8/Sample051613.xlsm

Thank you for your help I appreciate it very much!

sijpie · May 28, 2013

OK, using the file on the dropbox (similar to the screenshots above) this is the code you need. It outputs the formulas as text, not as formulas. Let me know if you need them as formulas.

Option Explicit Sub CreateFormulas() Const DELIM = "BLANK" ' 'Blank' will be replaced by colours Dim wsNLst As Worksheet, wsTplt As Worksheet, wsNL As Worksheet Dim rNN As Range, rTempl As Range, rOutp As Range Dim arEquations As Variant, arNN As Variant, arNewL As Variant, arHdr As Variant Dim j As Long, i As Long, k As Long, lShts As Long, lSize As Long, lEquations As Long On Error GoTo MisSheet Set wsNLst = Sheets("Name List") Set wsTplt = Sheets("Template") Set wsNL = Worksheets.Add(After:=wsTplt) ' wsNL.Name = "NewList" On Error GoTo 0 Set rNN = wsNLst.[A2] Set rTempl = wsTplt.[A2] Set rOutp = wsNL.[A1] ' dimension our working array lSize = rTempl.CurrentRegion.Rows.Count - 1 lEquations = rTempl.CurrentRegion.Columns.Count lShts = rNN.CurrentRegion.Rows.Count - 1 ReDim arNewL(1 To lSize * lShts, 1 To lEquations) ' Load template and codes into arrays arEquations = rTempl.Resize(lSize, lEquations) arNN = rNN.Resize(lShts, 2) 'code nr & code name ' create the headers into the output sheet rOutp.Resize(1, lEquations).Value = rTempl.Offset(-1, 0).Resize(1, lEquations).Value ' populate the otput array with the formulas _ by doing this in arrays it is blindingly fast For i = 1 To lShts For j = 1 To lSize For k = 1 To lEquations arNewL(j + (i - 1) * lSize, k) = "'" & Application.WorksheetFunction.Substitute( _ CStr(arEquations(j, k)), DELIM, MakeWorksheetName(CStr(arNN(i, 1)), CStr(arNN(i, 2)))) 'SUBSTITUTE(Text,Old_Text,New_Text) _ as the functions expect strings, and the arrays are variants, you have to _ cast the array members to string with CStr() Next k ' Put te code number in column 2 of the array arNewL(j + (i - 1) * lSize, 2) = arNN(i, 1) Next j Next i ' Now output the array to the sheet, one line below the header rOutp.Offset(1, 0).Resize(lSize * lShts + 1, lEquations).Value = arNewL 'finished Exit Sub MisSheet: MsgBox "Sheets missing or output sheet already exists" End Sub Function MakeWorksheetName(sCdNr As String, sCdNm As String) As String MakeWorksheetName = sCdNr & Mid(sCdNm, 1, 18) & "_EMS" End Function

sijpie · May 28, 2013

I forgot to mention: you don't need to combine the code & code number first, this will be done in the macro with the function 'MakeSheetName' which is based on the macro you had to do it on the sheet. Now it is done on the fly.

Need to combine information from two different worksheets on new worksheet

evisu18

New Member

Excel Facts

sijpie

Well-known Member

sijpie

Well-known Member

evisu18

New Member

sijpie

Well-known Member

sijpie

Well-known Member

sijpie

Well-known Member

evisu18

New Member

sijpie

Well-known Member

sijpie

Well-known Member

Similar threads

Forum statistics

Share this page

Need to combine information from two different worksheets on new worksheet

New Member

Excel Facts

Well-known Member

Well-known Member

New Member

Well-known Member

Well-known Member

Well-known Member

New Member

Well-known Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock