Re: Delete Rows with multiple conditions in Excel
Hi
Use this formula in L2 and copied down
=SUMIF($C$2:$C$11,C2,$J$2:$J$11)+SUMIF($C$2:$C$11,C2,$K$2:$K$11)
Now filter this column for 0s and delete those rows.
Re: Delete Rows with multiple conditions in Excel
Hi
Use this formula in L2 and copied down
=SUMIF($C$2:$C$11,C2,$J$2:$J$11)+SUMIF($C$2:$C$11,C2,$K$2:$K$11)
Now filter this column for 0s and delete those rows.
Re: Dependant drop down in user form
You don't need multiple Select cases. Try
[vb]Private Sub cboEmp_Change()
Dim index As Integer
Dim rngEmp As Range
Dim rngType As Range
Dim ws As Worksheet
Set ws = Worksheets("ListData")
index = cboType.ListIndex
Select Case index
Case Is = 0
With cboType
.Clear
For Each rngType In ws.Range("TypeList")
Me.cboType.AddItem rngEmp.Value
Next rngType
End With
Case Is = 1
With cboType
.Clear
For Each rngType In ws.Range("Type2List")
Me.cboType.AddItem rngType.Value
Next rngType
End With
End Select
End Sub[/vb]
Re: Multiple Macros under One Button
Hi
If you read Kj's post again, he has explicitly said, put the code in a standard module. Your code is in Worksheet module. Remove the code from sheet module and put it in standard module.
Re: Dependant drop down in user form
Hi Pigger77,
Welcome to board !!!
Can you please wrap the code using code tags ?
Also you can see 2 answers (specific to your problem) below this page (Possible answers)
Re: USD $20 Need to Amend Macro that Populates Sheet with Selected Data
And if you want to use your own code, here it is... (no row addition needed)
[vb]Sub Labels_2a()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim r As Integer
Dim c As Integer
Dim p As Integer
Dim r1 As Integer
Dim r2 As Integer
Dim r3 As Integer
Dim r4 As Integer
Dim i As Integer
Dim c1 As Integer
Dim w, j As Long
'Set sh1 = Sheets("LabelData")
Set sh2 = Sheets("LabelTemplate (2)")
'sh2.Cells.MergeCells = False
w = Array("LabelData", "LabelData2", "LabelData3")
sh2.Cells.ClearContents
r = 0
c = 1
p = 1
For j = 0 To UBound(w)
Set sh1 = Worksheets(CStr(w(j)))
For i = 4 To 51
If UCase(sh1.Cells(i, 16)) = "Y" Then
r = r + 1
If r > 4 Then
r = 1
c = c + 1
End If
If c > 2 Then
p = p + 1
r = 1
c = 1
End If
If r = 1 Then r1 = 3 + (53 * (p - 1))
If r = 2 Then r1 = 6 + 9 + (53 * (p - 1))
If r = 3 Then r1 = 8 + 18 + (53 * (p - 1))
If r = 4 Then r1 = 11 + 27 + (53 * (p - 1))
If r = 5 Then r1 = 14 + 36 + (53 * (p - 1))
If r = 6 Then r1 = 17 + 45 + (53 * (p - 1))
If r = 7 Then r1 = 20 + 54 + (53 * (p - 1))
If r = 8 Then r1 = 23 + 63 + (53 * (p - 1))
If c = 1 Then c1 = 3
If c = 2 Then c1 = 20
sh2.Cells(r1 + 1, c1) = sh1.Cells(i, 7)
sh2.Cells(r1 + 1, c1 + 10) = sh1.Cells(i, 9)
sh2.Cells(r1 + 2, c1) = sh1.Cells(i,
sh2.Cells(r1 + 3, c1) = sh1.Cells(i, 10)
sh2.Cells(r1 + 4, c1 + 1) = sh1.Cells(i, 11)
sh2.Cells(r1 + 4, c1 + 11) = sh1.Cells(i, 12)
sh2.Cells(r1 + 5, c1 + 7) = sh1.Cells(i, 13)
sh2.Cells(r1 + 5, c1 + 11) = sh1.Cells(i, 14)
End If
Next i
Next
'Stop
'sh2.PrintOut
sh2.Select
Cells(1, 1).Select
End Sub[/vb]
Re: USD $20 Need to Amend Macro that Populates Sheet with Selected Data
Quote from Craigside;791566I am now testing in my main business SS. Please can you remove the extra row you added, as I think it is throwing out my labels. I think I have a couple of other snags but it will be easier once it clears the the template and focusses after running...
many thanks
Hi Rob,
As I added the rows between those labels, you can delete one row from the beginning of each page and this is a one time activity. I can't attach the final workbook now as I'm at work.
Please find the revised code.
[vb]Option Explicit
Sub PrintLabels()
Dim i As Long
Dim j As Long
Dim n As Long
Dim d As Variant 'label data from each sheet
Dim k() As Variant 'output array
Dim c As Long 'left/right label. c=1 left, c=2 right
Dim w As Variant 'worksheet names array
Dim b As Long 'starting column adjustment
Dim q As Long 'vertical label count
w = Array("LabelData", "LabelData2", "LabelData3") '<<< sheet names
ReDim k(1 To 311, 1 To 32) '<<< output array [B4:AG314]
c = 1
For j = LBound(w) To UBound(w)
With Worksheets(CStr(w(j)))
d = .Range("g4", .Cells(.Rows.Count, "p").End(3)).Value
End With
If IsArray(d) Then
For i = 1 To UBound(d, 1)
If LCase(d(i, 10)) = "y" Then
If n = 0 And c = 1 Then
n = n + 1: q = q + 1: b = 1
Else
If c = 1 Then
b = 1: n = n + 12: q = q + 1
Else
b = 18
End If
End If
k(n, b + 1) = d(i, 1): k(n, b + 11) = d(i, 3)
k(n + 1, b + 1) = d(i, 2): k(n + 2, b + 1) = d(i, 4)
k(n + 3, b + 2) = d(i, 5): k(n + 3, b + 12) = d(i, 6)
k(n + 4, b + = d(i, 7): k(n + 4, b + 12) = d(i,
If c = 1 Then c = c + 1 Else: c = 1
If q Mod 4 = 0 And b = 18 Then n = n + 5
End If
Next
End If
Next
If n Then
With Worksheets("LabelTemplate")
.UsedRange.ClearContents 'clears everything
'.Range("b4").Resize(UBound(k, 1), UBound(k, 2)).ClearContents
.Range("b4").Resize(UBound(k, 1), UBound(k, 2)).Value = k
On Error Resume Next
Application.Goto .Cells(1) 'focus to LabelTemplatesheet
End With
End If
End Sub[/vb]
Re: USD $20 Need to Amend Macro that Populates Sheet with Selected Data
Okay.
slight adjustment. Use this code.
[vb]Option Explicit
Sub PrintLabels()
Dim i As Long
Dim j As Long
Dim n As Long
Dim d As Variant 'label data from each sheet
Dim k() As Variant 'output array
Dim c As Long 'left/right label. c=1 left, c=2 right
Dim w As Variant 'worksheet names array
Dim b As Long 'starting column adjustment
Dim q As Long 'vertical label count
w = Array("LabelData", "LabelData2", "LabelData3") '<<< sheet names
ReDim k(1 To 311, 1 To 32) '<<< output array [B4:AG314]
c = 1
For j = LBound(w) To UBound(w)
With Worksheets(CStr(w(j)))
d = .Range("g4", .Cells(.Rows.Count, "p").End(3)).Value
End With
If IsArray(d) Then
For i = 1 To UBound(d, 1)
If LCase(d(i, 10)) = "y" Then
If n = 0 And c = 1 Then
n = n + 1: q = q + 1: b = 1
Else
If c = 1 Then
b = 1: n = n + 12: q = q + 1
Else
b = 18
End If
End If
k(n, b + 1) = d(i, 1): k(n, b + 11) = d(i, 3)
k(n + 1, b + 1) = d(i, 2): k(n + 2, b + 1) = d(i, 4)
k(n + 3, b + 2) = d(i, 5): k(n + 3, b + 12) = d(i, 6)
k(n + 4, b + = d(i, 7): k(n + 4, b + 12) = d(i,
If c = 1 Then c = c + 1 Else: c = 1
If q Mod 4 = 0 And b = 18 Then n = n + 6
End If
Next
End If
Next
If n Then
With Worksheets("LabelTemplate")
.Range("b4").Resize(UBound(k, 1), UBound(k, 2)).ClearContents
.Range("b4").Resize(UBound(k, 1), UBound(k, 2)).Value = k
End With
End If
End Sub[/vb]
Re: $50 for VBA code to build indented BOM structure
Payment received. File sent by email.
:cheers:
Re: $50 for VBA code to build indented BOM structure
Hi
The code is ready. Please make the payment. Will share the solution once you confirm the payment.
Re: $50 for VBA code to build indented BOM structure
Will deliver it latest by Saturday.
Re: $50 for VBA code to build indented BOM structure
I got two files. I think the second one is the correct one.
BTW, what's the timelines to get this done ?
Re: USD $50 Data Reformat Script
File sent by email. Funds received.
Re: $50 for VBA code to build indented BOM structure
Hi
I can look at this for you. Which version if Excel you are using and on which OS ?
Re: Trying to write "2nd highest" score in addition to MaxScore.
I think your original question has been answered here. You should start a new thread explaining the problem. You can link this thread in the new post, if necessary.
Re: Extract Records From Different Ranges and Filter Results
Change the COUNTIF formula in H16, like
=COUNTIFS($G$4:$G$13,">="&H17,$G$4:$G$13,"<="&H18,$A$4:$A$13,"North")
Re: USD $50 Data Reformat Script
I can look at this for you.
Re: Copy paste data from one dynamic column to another
Try something like
[vb]Option Explicit
Sub kTest()
Dim PasteCol As Range
Dim CopyCol As Range
Dim LCol As Long
Dim LRow As Long
Dim r As Long
With ActiveSheet
Set PasteCol = Nothing
Set PasteCol = .UsedRange.Rows(1).Find("Trade Date", lookat:=1) '<<header
If Not PasteCol Is Nothing Then
LCol = .Cells(.UsedRange.Row, .Columns.Count).End(xlToLeft).Column
LRow = .Cells(.Rows.Count, PasteCol.Column).End(xlUp).Row
Set CopyCol = .Range(.Cells(.UsedRange.Row + 1, LCol + 1), .Cells(LRow, LCol + 1))
For r = 1 To CopyCol.Rows.Count Step 2
If Len(CopyCol.Cells(r, 1).Value) Then
PasteCol.Cells(r + 1, 1).Value = CopyCol.Cells(r, 1).Value
End If
Next
End If
End With
End Sub[/vb]