Conditional VBA

G

Giri85

New Member
Joined
Feb 28, 2014
Messages
7
Dear all,

Could anyone help me with below problem.

I am looking for VBA code to extract data from each tab into master tab based on data.

I have 3 tabs (inputs)

Tab1 (Dept A-NAME) (RANGE B4:I7)

[TABLE="width: 544"]
<tbody>[TR]
[TD]SL NO[/TD]
[TD]ID[/TD]
[TD]Date[/TD]
[TD]Customer[/TD]
[TD]Start Time[/TD]
[TD]End Time[/TD]
[TD]Trucks[/TD]
[TD]Supervisor[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]A[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 1[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]3[/TD]
[TD]ABC[/TD]
[/TR]
[TR]
[TD="align: right"]2[/TD]
[TD]A[/TD]
[TD="align: right"]2/24/2014[/TD]
[TD]Customer 2[/TD]
[TD="align: right"]11[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]5[/TD]
[TD]CDE[/TD]
[/TR]
[TR]
[TD="align: right"]3[/TD]
[TD]A[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 3[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]2[/TD]
[TD]FGK[/TD]
[/TR]
</tbody>[/TABLE]
Tab 2 (Dept B-NAME) (RANGE B4:I11)

[TABLE="width: 564"]
<tbody>[TR]
[TD]SL NO[/TD]
[TD]ID[/TD]
[TD]Date[/TD]
[TD]Customer[/TD]
[TD]Start Time[/TD]
[TD]End Time[/TD]
[TD]Trucks[/TD]
[TD]Supervisor[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]B[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 3[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]3[/TD]
[TD]RTY[/TD]
[/TR]
[TR]
[TD="align: right"]2[/TD]
[TD]B[/TD]
[TD="align: right"]2/24/2014[/TD]
[TD]Customer 1[/TD]
[TD="align: right"]11[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]5[/TD]
[TD]CDE[/TD]
[/TR]
[TR]
[TD="align: right"]3[/TD]
[TD]B[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 2[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]2[/TD]
[TD]FGK[/TD]
[/TR]
[TR]
[TD="align: right"]4[/TD]
[TD]B[/TD]
[TD="align: right"]2/19/2014[/TD]
[TD]Customer 3[/TD]
[TD="align: right"]7[/TD]
[TD="align: right"]8[/TD]
[TD="align: right"]8[/TD]
[TD]CCC[/TD]
[/TR]
[TR]
[TD="align: right"]5[/TD]
[TD]B[/TD]
[TD="align: right"]2/19/2014[/TD]
[TD]Customer 4[/TD]
[TD="align: right"]8[/TD]
[TD="align: right"]9[/TD]
[TD="align: right"]5[/TD]
[TD]DDD[/TD]
[/TR]
[TR]
[TD="align: right"]6[/TD]
[TD]B[/TD]
[TD="align: right"]2/19/2014[/TD]
[TD]Customer 5[/TD]
[TD="align: right"]9[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]1[/TD]
[TD]ABC[/TD]
[/TR]
[TR]
[TD="align: right"]7[/TD]
[TD]B[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 6[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1.3[/TD]
[TD="align: right"]4[/TD]
[TD]MMM[/TD]
[/TR]
</tbody>[/TABLE]
Tab 3 (Dept C-NAME) (RANGE B4:I7)

Is it possible to run vba code to get below result in new tab

[TABLE="width: 529"]
<tbody>[TR]
[TD]SL NO[/TD]
[TD]ID[/TD]
[TD]Date[/TD]
[TD]Customer[/TD]
[TD]Start Time[/TD]
[TD]End Time[/TD]
[TD]Trucks[/TD]
[TD]Supervisor[/TD]
[TD]Result[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]A[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 1[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]3[/TD]
[TD]ABC[/TD]
[TD]Dept A[/TD]
[/TR]
[TR]
[TD="align: right"]3[/TD]
[TD]A[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 3[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]2[/TD]
[TD]FGK[/TD]
[TD]Dept A[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]B[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 3[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]3[/TD]
[TD]RTY[/TD]
[TD]Dept B[/TD]
[/TR]
[TR]
[TD="align: right"]3[/TD]
[TD]B[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 2[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]2[/TD]
[TD]FGK[/TD]
[TD]Dept B[/TD]
[/TR]
[TR]
[TD="align: right"]7[/TD]
[TD]B[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 6[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1.3[/TD]
[TD="align: right"]4[/TD]
[TD]MMM[/TD]
[TD]Dept B[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]C[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 8[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]
[TD]QWE[/TD]
[TD]Dept C[/TD]
[/TR]
[TR]
[TD="align: right"]2[/TD]
[TD]C[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 3[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]1[/TD]
[TD]FGK[/TD]
[TD]Dept C[/TD]
[/TR]
</tbody>[/TABLE]

Condition here is date 2/25/2014, is possible when running code message box pops up to ask date, when we give conditional date it extracts those dates.

Execel -2007 & Windows 7

Thanks,
Giri
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Sort by date Sort by votes
Sorry,

In above question I didn't post sample Tab 3 data

[TABLE="width: 597"]
<colgroup><col span="2"><col><col><col span="3"><col></colgroup><tbody>[TR]
[TD]SL NO[/TD]
[TD]ID[/TD]
[TD]Date[/TD]
[TD] Customer[/TD]
[TD]Start Time[/TD]
[TD]End Time[/TD]
[TD]Trucks[/TD]
[TD]Supervisor[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]C[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD] Customer 8[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]
[TD]QWE[/TD]
[/TR]
[TR]
[TD="align: right"]2[/TD]
[TD]C[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD] Customer 3[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]1[/TD]
[TD]FGK[/TD]
[/TR]
[TR]
[TD="align: right"]3[/TD]
[TD]C[/TD]
[TD="align: right"]2/3/2014 [/TD]
[TD]Customer 4[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]1[/TD]
[TD]HJK

[/TD]
[/TR]
</tbody>[/TABLE]
This is only sample data , real file has data in lakhs and has around 13 different departments

Thanks,
Giri
 
Upvote 0
Dear all,

In view of being stuck, Is it possible to modify below code found here in previous post to achieve above results.Thanks venkat for previous code.
This code does most of requirement, then we need to search non conditional dates in main tab created by below code delete them from main tab.

May be if one macro not possible to do both jobs, could any one help to create 2nd macro to do second part of requirement.

Thanks
Giri



Sub test()Dim r As Range, j As Integer, k As Integer, dest As Range'===============Dim sh As Worksheet, flg As BooleanFor Each sh In WorksheetsIf sh.Name Like "summary*" Then flg = True: Exit ForNextIf flg = True ThenGoTo proceedElseSheets.Add.Name = "summary"End If'===================proceed:j = Worksheets.CountFor k = 1 To jIf Worksheets(k).Name = "summary" Then GoTo nextkWith Worksheets(k)Set r = Range(.Range("A2"), .Range("A2").End(xlToRight).End(xlDown))r.Copy'With Worksheets("sheet3")With Worksheets("summary")Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)dest.PasteSpecialRange(dest.End(xlToRight).Offset(0, 1), dest.End(xlDown).End(xlToRight).Offset(0, 1)).FormulaArray = _ Right(Worksheets(k).Name, 4) & Left(Worksheets(k).Name, 2)End WithEnd Withnextk:Next kWorksheets(1).Range("A1").EntireRow.Copy Worksheets("summary").Range("A1")End Sub</pre></pre>
 
Upvote 0
Hi,
code you posted not readable - you need to use code tags when posting code.

Try this code I adapted from another OP I assisted recently with a similar requirement.

Code for both procedures should be placed in standard module & it assumes that you have a worksheet named "Summary" and that dates are in Column 3 (C) are real dates.

Code: 
Sub GetData(ByVal ws As Object, ByVal StartDate As Date, ByVal EndDate As Date)
    Dim lr As Long
    Dim lStartdate As Long
    Dim lEndDate As Long
    Dim rng As Range
    Dim FilterRange As Long
    Application.ScreenUpdating = False
    
    lStartdate = DateSerial(Year(StartDate), Month(StartDate), Day(StartDate))
    lEndDate = DateSerial(Year(EndDate), Month(EndDate), Day(EndDate))
    
    With ws
        lr = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("A1:I" & lr).AutoFilter Field:=3, _
                                       Criteria1:=">=" & lStartdate, _
                                       Operator:=xlAnd, _
                                       Criteria2:="<=" & lEndDate
        Set rng = .AutoFilter.Range
        
        FilterRange = rng.Columns(3).SpecialCells(xlCellTypeVisible).Count - 1
        
        If FilterRange > 0 Then
            'copy range A to I & Paste to Summary Sheet
            .Range("A2:I" & lr).SpecialCells(xlCellTypeVisible).Copy
            
            With ThisWorkbook.Worksheets("Summary")
            lr = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                With .Range("A" & lr)
                    .PasteSpecial Paste:=xlPasteValues
                    .PasteSpecial Paste:=xlPasteFormats
                End With
            End With
        End If
    End With
    rng.AutoFilter
    
End Sub

Sub CopyByStartEnd()
    Dim wsSource As Worksheet
    Dim sPrompt As Variant
    Dim sTitle As Variant
    Dim DateIn(2) As Variant
    Dim i As Integer
    Dim LineFeed As String
    LineFeed = Chr(10) & Chr(10)
    On Error GoTo myerror

    sPrompt = Array("Enter Date From", "Enter Date To")
    sTitle = Array("Select Start Date", "Select End Date")
    i = 0
    Do
        DateIn(i) = InputBox(sPrompt(i), sTitle(i))
        If DateIn(i) = vbNullString Then
            msg = MsgBox("Do You Want To Quit?" & Space(10), 36, "Exit Application")
            If msg = 6 Then Exit Sub
        ElseIf Not IsDate(DateIn(i)) Then
            MsgBox DateIn(i) & Chr(10) & "Not A Valid Date", 16, "Error"
        Else
            DateIn(i) = CDate(DateIn(i))
            i = i + 1
        End If
        If i > 1 And DateIn(1) < DateIn(0) Then
            MsgBox "   DateTo: " & DateIn(1) & " " & LineFeed & _
                   "Is earlier Than" & LineFeed & _
                   "DateFrom: " & DateIn(0) & Space(10), 16, "Input Error"
            i = i - 1
        End If
    Loop Until i > 1
    ThisWorkbook.Worksheets("Summary").UsedRange.Offset(1, 0).ClearContents
    For Each wsSource In Worksheets
        If wsSource.Name <> "Summary" Then
            GetData wsSource, DateIn(0), DateIn(1)
        End If
    Next wsSource

myerror:
Application.ScreenUpdating = True

    If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Hope Helpful

Dave
 
Last edited:
Upvote 0
Dear Dave,

Thanks for code, it exactly what i needed. Code is of great help for me.

Would it be possible to remove 2 empty rows between new tabs and their heading? in summary tab (red color),

[TABLE="width: 479"]
<tbody>[TR]
[TD]SL NO[/TD]
[TD]ID[/TD]
[TD]Date[/TD]
[TD]Customer[/TD]
[TD]Start Time[/TD]
[TD]End Time[/TD]
[TD]Trucks[/TD]
[TD]Supervisor[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]A[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 1[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]3[/TD]
[TD]ABC[/TD]
[/TR]
[TR]
[TD="align: right"]3[/TD]
[TD]A[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 3[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]2[/TD]
[TD]FGK[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SL NO
[/TD]
[TD]ID [/TD]
[TD]Date [/TD]
[TD]Customer [/TD]
[TD]Start Time [/TD]
[TD]End Time [/TD]
[TD]Trucks [/TD]
[TD]Supervisor[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]B[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 3[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]3[/TD]
[TD]RTY[/TD]
[/TR]
[TR]
[TD="align: right"]3[/TD]
[TD]B[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 2[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]2[/TD]
[TD]FGK[/TD]
[/TR]
[TR]
[TD="align: right"]7[/TD]
[TD]B[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 6[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1.3[/TD]
[TD="align: right"]4[/TD]
[TD]MMM[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SL NO [/TD]
[TD]ID [/TD]
[TD]Date [/TD]
[TD]Customer [/TD]
[TD]Start Time [/TD]
[TD]End Time [/TD]
[TD]Trucks [/TD]
[TD]Supervisor[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]C[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 8[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]
[TD]QWE[/TD]
[/TR]
[TR]
[TD="align: right"]2[/TD]
[TD]C[/TD]
[TD="align: right"]2/25/2014[/TD]
[TD]Customer 3[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]1[/TD]
[TD]FGK[/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="width: 73"]
<tbody>[TR]
[TD="width: 73"]Thanks,
Giri[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Hi Giri,
Not sure I fullly understand you. Code consolidates data to summary sheet with headings on row 1 and no spaces.

Are you saying code is behaving differently to this? or do you want to include header row for each tab shown in the summary sheet spaced 2 rows apart?

Dave
 
Upvote 0
Hi Dave,

Code while combining 3 tabs data, leaves2 rows empty and also again puts 2nd and 3rdtab heading, I was hoping this can be done away with as 2nd and 3rd tab heading will be repetitive.

In above eg

After running code Row1,2,3 in summary tab as 1st tab data, then row 4,5 are empty rows and row6 again has tab 2 heading then from row 7 tab 2 data which meets criteria starts in summary tab, i was hoping to eliminate 4,5 empty rows and row 6 heading in summary tab. ir in row4 itself we get 2nd tab data.let me know if more clarity is needed.

Regards,
Giri
 
Upvote 0
Hi,
would it be possible to place copy of your workbook with some sample data in a dropbox?

Dave
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Few problems with dynamic arrays
2
Replies
15
Views
250
djclements
djclements
S
  • Question Question
Conditional top 10 Modes
Replies
1
Views
195
smit3446
S
T
  • Solved
Integer programming with binary variables in Solver - issue with constraint?
Replies
3
Views
278
StephenCrump
S
B
  • Solved
Average of last X transactions by customer
Replies
5
Views
311
Dave Patton
D
Kellie220
  • Question Question
VBA to Collapse Rows (3 part question)
Replies
1
Views
236
Artik
Artik

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top