Hi Carim
Google is a great teacher, many hours of research, trial and error and of course the icing on cake is the help from OZGrid.
Posts by jan_g
-
-
Hi Carim,
Thank you for the file ..works perfectly. I figured it probably needed to do a check of the cell, but converting the mental logic to VBA is sometimes difficult especially when one is a beginner. I enjoy the challenge and am very grateful for the help and your dedication to helping others.
Cheers and have a great day.
J
-
Hi Carim,
Thanks for the above. I think line 28 does check for numeric/alpha and it produce the correct result in the label macro, but I'm stuck with the size replicating per the count instead of just once per line in the Export macro. Please let me know if I am not explaining clearly.
CodeIf (IsNumeric(Left(ws1.Cells(i, 6).Value, 1))) = True ThenCheers
J
-
Hi
I have a list of data in table format which is copied to 2 different tabs.
Labels Tab - replicates the data N times based on the Value in each column H:M, then based on the size details in column F, fills in the size on each row. - This Macro works perfectly well.
Export Tab - counts the number of cells containing data in each row, and replicates N times based on the Count. (if there are 3 sizes with orders, copy the row 3 times and show which sizes are ordered) This replication is working but I cannot figure out how to get the size to show only once and not for the count. The code is using .value which is causing the issue but I cannot figure out. after several hours of trying, what to change it to
I hope this makes sense.
Many thanks in advance.
J
Code
Display MoreOption Explicit Sub Export() '----Create a list of products for export - require 1 row for each size orderd Dim ws1 As Worksheet, ws2 As Worksheet Dim i As Long, j As Long, n As Integer Set ws1 = Worksheets("Data") Set ws2 = Worksheets("Export") Application.ScreenUpdating = False '-----Clear Existing Results With ws2.Cells(1, 1) .CurrentRegion.ClearContents End With '-----Replicate Rows based on Counts On Error Resume Next For i = 3 To ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row n = WorksheetFunction.CountIf(ws1.Range("H" & i & ": M" & i), ">0") 'Count the number of cells with data in cols H-M ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Offset(1).Resize(n, 4).Value = ws1.Cells(i, 2).Resize(, 4).Value ' Insert "n" rows & get data Cols B-E ws2.Cells(ws2.Rows.Count, 5).End(xlUp).Offset(1).Resize(n, 1).Value = ws1.Cells(i, 7).Resize(, 1).Value ' Get the RRP '-----???This section is not giving the desired result '-----Get the sizes For j = 8 To 13 If (IsNumeric(Left(ws1.Cells(i, 6).Value, 1))) = True Then ws2.Cells(ws2.Rows.Count, 6).End(xlUp).Offset(1).Resize(ws1.Cells(i, j).Value, 1).Value = ws1.Cells(2, j).Resize(1, j).Value Else ws2.Cells(ws2.Rows.Count, 6).End(xlUp).Offset(1).Resize(ws1.Cells(i, j).Value, 1).Value = ws1.Cells(1, j).Resize(1, j).Value End If Next j Next i Application.CutCopyMode = False End Sub -
Hi Carim
Yes this is perfect thank you so much.
Enjoy the rest of your day.
Jan
-
Hi Carim,
Thank you for the prompt response and for you continued dedication to helping us on this site. Not sure what you meant with looking for a patch?
Anyway, I tried the code but got a Runtime Error - Type Mismatch on line 13..
Any clues?
Cheers
J
-
Hi
I have data that sums across columns based on column header. I need to take these totals and transpose to a single column without the 0 results.
Currently the code (thanks to another user) results in a blank cell where the formula result is zero.
How can I transpose the data so that there are no blank (zero) cells in the resulting list? Pls refer screenshot for desired result
I thought an If > 0 statement might work but I got the same result. Skip blanks is also not applicable as there are results for the formula.
Many thanks for your help once again.
J
Code
Display MoreSub transposeColumns() Dim R1 As Range Dim R2 As Range Dim R3 As Range Dim RowN As Integer wTitle = "Transpose multiple rows/columns" Set R1 = Application.Selection Set R1 = Application.InputBox("Select the Source data of Ranges to be copied:", wTitle, R1.Address, Type:=8) Set R2 = Application.InputBox("Select one destination Cell or column:", wTitle, Type:=8) RowN = 0 Application.ScreenUpdating = False For Each R3 In R1.Rows R3.copy R2.Offset(RowN, 0).PasteSpecial Paste:=xlPasteValues, Transpose:=True RowN = RowN + R3.Columns.Count Next Application.CutCopyMode = False Application.ScreenUpdating = True End Sub -
Thanks..I did read that one too but it is clearer now with your explanation. Really appreciate your time and kindness.
Cheers.
-
Hi Jolivanes,
Fantastic. Thank you so much for your patience with this. I have run both sets of code but prefer you last option in Comment 12 because of the flexibility with columns.
I have spent some time understanding the code but don't quite follow the syntax in line 7 - Find "RRP" in Row 3. Commas rep Optional arguments - how do you know how many to put in? and what is the "1"? If you have a moment, could you please explain.I have read these 2 article https://docs.microsoft.com/en-…/vba/api/Excel.Range.Find and this https://www.ozgrid.com/VBA/find-method.htm but still not quite getting the syntax.
Cheers and have a great day.
-
After spending much time searching with no progress, I have made some changes to the above code and have used WorksheetFunction.Countif.
(The if/else statement has been removed as I couldn't get it to give the correct result....still some work needed.)
The issue with the code to this point is that without the "on Error Resume Next" I get an "Application Defined or Object Defined" error on Line 22. But I cannot work out what the problem is with the code. Any pointers in the right direction would be much appreciated as I am completely stumped. Thanks.
Code
Display MoreOption Explicit Sub NewList2() 'Create a list of product info for Import Dim shO As Worksheet, shL As Worksheet Dim i As Long, j As Long, n As Integer Set shO = Worksheets("Data") Set shL = Worksheets("Export List") Application.ScreenUpdating = False '-----Clear Existing Results With shL.Cells(1, 1) .CurrentRegion.ClearContents End With '-----Replicate Rows based on Counts On Error Resume Next For i = 4 To shO.Cells(shO.Rows.Count, 2).End(xlUp).Row n = WorksheetFunction.CountIf(shO.Range("H" & i & ": M" & i), ">0") 'Count the number of cells with data in cols H-M shL.Cells(shL.Rows.Count, 1).End(xlUp).Offset(1).Resize(n, 4).Value = shO.Cells(i, 2).Resize(, 4).Value ' Insert "n" rows & get data Cols B-E shL.Cells(shL.Rows.Count, 5).End(xlUp).Offset(1).Resize(n, 1).Value = shO.Cells(i, 7).Resize(, 1).Value ' Get the RRP Next i Application.CutCopyMode = False End Sub -
Thank you Jolivanes ...but I get an invalid qualifier error for cnt variable. Tried String and Integer. Same.
Dim as Variant runs..but no results.
Cheers
-
Hi Roy,
I have up uploaded a new formatted spreadsheet. In doing so I noticed a code error which I have updated. This code was adapted from a larger project where the rows were resized based on the numbers in each size columns but for this project I only require the rows to be resized by the count. My apologies if this caused confusion. As mentioned above, is it possible to replace the reference to Column 14 with a variable? I just can't get the formula to work.
Thanks.
Jan
Code
Display MoreSub NewList() 'Create a list of product info for Import Dim shO As Worksheet, shL As Worksheet Dim lastrow As Long, i As Long, j As Long, cnt As Long Dim rng As Range cnt = 0 Set shO = Worksheets("Data") Set shL = Worksheets("Export List") Application.ScreenUpdating = False '-----Clear List With shL.Cells(1, 1) .CurrentRegion.ClearContents End With '-----Replicate Rows based on Counts On Error Resume Next For i = 4 To shO.Cells(shO.Rows.Count, 2).End(xlUp).Row For j = 8 To 13 'cnt.FormulaR1C1 = "=COUNTIF(RiC7:RiC12,>0)" 'Cannot get this to work. Will replace col references below with variable shL.Cells(shL.Rows.Count, 1).End(xlUp).Offset(1).Resize(shO.Cells(i, 14).Value, 4).Value = shO.Cells(i, 2).Resize(, 4).Value ' Get data first 4 columns from Orders If (IsNumeric(Left(shO.Cells(i, 6).Value, 1))) = True Then shL.Cells(shL.Rows.Count, 5).End(xlUp).Offset(1).Resize(shO.Cells(i, 14).Value, 1).Value = shO.Cells(3, j).Resize(1, 14).Value Else shL.Cells(shL.Rows.Count, 5).End(xlUp).Offset(1).Resize(shO.Cells(i, 14).Value, 1).Value = shO.Cells(2, j).Resize(1, j).Value End If shL.Cells(shL.Rows.Count, 6).End(xlUp).Offset(1).Resize(shO.Cells(i, 14).Value, 1).Value = shO.Cells(i, 7).Resize(, 1).Value ' Get the RRP Next j Next i Application.CutCopyMode = False End Sub -
Hello,
I thought this would be easy but everything I try gives me a blank sheet or a qualifier error. The code on the attached example gives the correct result when using a column reference to lookup Countif result (Sheet Orders Col14) in the For Loop. I want to change the code to use a variable for the "Countif" so that I can remove the column from the worksheet. I have tried using Application.WoksheetFuntion and R1C1 reference for the variable but am getting completely stuck. Hope that makes sense.
Really appreciate the help this site provides to all of us that are learning.
Cheers
Jan
Code
Display MoreOption Explicit Sub NewList() 'Create a list of product info for Import Dim shO As Worksheet, shL As Worksheet Dim lastrow As Long, i As Long, j As Long, cnt As Long Dim rng As Range cnt = 0 Set shO = Worksheets("Data") Set shL = Worksheets("Export List") Application.ScreenUpdating = False '-----Clear List With shL.Cells(1, 1) .CurrentRegion.ClearContents End With '-----Replicate Rows based on Counts On Error Resume Next For i = 4 To shO.Cells(shO.Rows.Count, 2).End(xlUp).Row 'cnt.FormulaR1C1 = "=COUNTIF(RiC7:RiC12,>0)" 'Cannot get this to work. Will replace col references below with variable shL.Cells(shL.Rows.Count, 1).End(xlUp).Offset(1).Resize(shO.Cells(i, 14).Value, 4).Value = shO.Cells(i, 2).Resize(, 4).Value ' Get data first 4 columns from Orders If (IsNumeric(Left(shO.Cells(i, 6).Value, 1))) = True Then shL.Cells(shL.Rows.Count, 5).End(xlUp).Offset(1).Resize(shO.Cells(i, 14).Value, 1).Value = shO.Cells(7, j).Resize(1, j).Value Else shL.Cells(shL.Rows.Count, 5).End(xlUp).Offset(1).Resize(shO.Cells(i, 14).Value, 1).Value = shO.Cells(6, j).Resize(1, j).Value End If shL.Cells(shL.Rows.Count, 6).End(xlUp).Offset(1).Resize(shO.Cells(i, 14).Value, 1).Value = shO.Cells(i, 6).Resize(, 1).Value ' Get the RRP Next i Application.CutCopyMode = False End Sub -
Hi,
Thanks for the file and for your time to assist. It is very much appreciated. That worked great. I added one further row to copy down the size Label into the last column as well.
Cheers and have a good day.
Code
Display MoreOption Explicit Sub Maybe() Dim shP As Worksheet, shL As Worksheet Dim i As Long, j As Long, n As Integer Set shP = Worksheets("Products") Set shL = Worksheets("Label") With shL.Cells(1, 1) .CurrentRegion.ClearContents .Resize(, 8) = shP.Cells(1, 1).Resize(, 8).Value End With For i = 2 To shP.Cells(shP.Rows.Count, 1).End(xlUp).Row For j = 4 To 8 shL.Cells(shL.Rows.Count, 1).End(xlUp).Offset(1).Resize(shP.Cells(i, j).Value, 8).Value = shP.Cells(i, 1).Resize(, 8).Value shL.Cells(shL.Rows.Count, 9).End(xlUp).Offset(1).Resize(shP.Cells(i, j).Value, 1).Value = shP.Cells(1, j).Resize(1, j).Value Next j Next i End Sub -
Hi Jolivanes,
Thank you for the code. I keep getting an Application Defined or Object Error on Line 16.
Cheers
-
Hi Jolivanes,
Sorry for the confusion.
In my company worksheet there are many other tabs which are interlinked with formulas and lookups. I could probably delete those and then replace all formula's with static values and change the data but I thought it simpler to give an example which mirrored what I was looking to achieve. If you prefer I do this then I can.
The products tab (10cols) contains all the info for each productThe Labels tab extracts only the information that is required for each label, hence only 9 columns.
Sorry..I'm a bit lost re Post #4?
To merge with MS Word, each product has to be on a different row..which the code does..I just don't quite know how to get the Size (XS,S etc) in a column.
Hope this makes a little more sense.
-
Hi, Understood, but the actual file contains lots of company sensitive information which I am unable to upload. The data and I have created in this file represents what the macro is trying to achieve. The labels only contain Product Code, Description, Colour and Size and a barcode which will be added later. Cheers.
-
Hi, No in the actual file only the required columns for the labels are copied across. There are many cols that are irrelevant. Cheers
-
Good Afternoon,
I am trying to set up a list of data to do a mail merge into Word Labels.
The Current macro copies the required columns (Products) to a new Sheet(Labels). Once copied, the rows are duplicated based on the total quantity so that the correct no of labels are printed.
From here...and I am not sure where to even start, I would like to take the Size of each garment and copy n times based on the count in the column. Sheet 3 shows what the end result should look like. Workbook attached.
Thanks for your help.
Code
Display MoreSub Labels2() Dim lastrow As Long Dim rng As Range lastrow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False 'Clear Labels Sheet Sheet1.Cells.Clear 'Copy Columns With Sheet2 .Activate .Range("A2:C" & lastrow & ", E2:J" & lastrow).Copy Sheet1.Range("A1") End With Application.CutCopyMode = False 'Remove any blank rows Sheet1.Select N = Cells(Rows.Count, "C").End(xlUp).Row For I = N To 1 Step -1 Set r = Cells(I, "c") If IsEmpty(r) Then r.EntireRow.Delete End If Next 'Replicate Rows based on the Value in Col I Range("a1:i1").Copy Range("k1") On Error Resume Next For Each rng In Range("I2", Range("I" & Rows.Count).End(xlUp)) Cells(Rows.Count, 11).End(xlUp)(2).Resize(rng.Value, 9) = rng.Offset(, -8).Resize(1, 9).Value Next rng End Sub -
Hi,
If Rows are deleted from the end Table A, then delete from end Table B.
If Table A & B are not on the same rows and structured references used, the delete code deletes the first rows not the bottom rows.
Cheers and thank you so much.
Code
Display MoreDim oTbl1 As ListObject, oTbl2 As ListObject Dim iX As Integer, iCnt As Integer Set oTbl1 = Sheet1.ListObjects("TableA") Set oTbl2 = Sheet1.ListObjects("TableB") If oTbl1.ListRows.Count > oTbl2.ListRows.Count Then iCnt = oTbl1.ListRows.Count - oTbl2.ListRows.Count MsgBox iCnt For iX = 1 To iCnt ''/// AlwaysInsert:=True: specifies whether to always shift data in cells below the last row of the table oTbl2.ListRows.Add AlwaysInsert:=True Next iX ElseIf oTbl1.ListRows.Count < oTbl2.ListRows.Count Then iCnt = oTbl2.ListRows.Count - oTbl1.ListRows.Count For iX = 1 To iCnt oTbl2.ListRows(1).Delete Next iX End If End Sub