What when wrong with my above vba codes?

I

imso

New Member
Joined
Jul 26, 2011
Messages
8
Hi Guys,

Brief description of what i want my macros to achieve: I've trying to import data from two Excel spreadsheets, and then compare the data on each list to find the missing elements in each list and then highlight the data row if it is missing.

An issue i encounter when i press ImportButton2_Click. The spreadsheet i copied goes on to replace the "position" i import previously from pressing ImportButton1_Click. I wanted a clear order of which spreadsheet should come first when i import the documents. Any ideas how can i solve this problem?

Sorry if my information is not clear for you to understand. Thanks

Code: 
Private Sub ImportButton1_Click()

Dim OpenFile As Variant
Dim FileName As String
CheckBoolean1 = True

If CheckBoolean2 = False Then
    ComparisonButton.Enabled = False
ElseIf CheckBoolean1 = True And CheckBoolean2 = True Then
        ComparisonButton.Enabled = True
End If
'-----------------------------------------------------------------------------
Dim Wkb1 As Workbook
Set Wkb1 = ActiveWorkbook

OpenFile = Application.GetOpenFilename( _
FileFilter:="Excel Files, *.xls; *.csv; *.xlsx", Title:="Importing Excel File 1")

If OpenFile = False Then
MsgBox "Please Select a Excel File"
Exit Sub
Else
Workbooks.Open OpenFile
End If

FileName = ActiveWorkbook.Name

Worksheets(1).Copy after:=Wkb1.Worksheets(1)

Workbooks(FileName).Close SaveChanges:=False
'-----------------------------------------------------------------------------

stringOfSheet1 = ActiveWorkbook.Name

End Sub

Private Sub ImportButton2_Click()

Dim OpenFile As Variant
Dim FileName As String
CheckBoolean2 = True

If CheckBoolean1 = False Then
    ComparisonButton.Enabled = False
ElseIf CheckBoolean1 = True And CheckBoolean2 = True Then
        ComparisonButton.Enabled = True
End If
'-------------------------------------------------------------------------------
Dim Wkb1 As Workbook
Set Wkb1 = ActiveWorkbook

OpenFile = Application.GetOpenFilename( _
FileFilter:="Excel Files, *.xls; *.csv; *.xlsx", Title:="Importing Excel File 2")

If OpenFile = False Then
MsgBox "Please Select a Excel File"
Exit Sub
Else
Workbooks.Open OpenFile
End If

FileName = ActiveWorkbook.Name

Worksheets(1).Copy after:=Wkb1.Worksheets(1)

Workbooks(FileName).Close SaveChanges:=False
'-------------------------------------------------------------------------------

stringOfSheet2 = ActiveWorkbook.Name

End Sub
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
Sort by date Sort by votes
imso said:
An issue i encounter when i press ImportButton2_Click. The spreadsheet i copied goes on to replace the "position" i import previously from pressing ImportButton1_Click. I wanted a clear order of which spreadsheet should come first when i import the documents.
Click to expand...

Hello and Welcome,

This line of your code says to import the sheet after the first worksheet in Wkb1.
Rich (BB code): 
Worksheets(1).Copy after:=Wkb1.Worksheets(1)

If you want the imported sheet to become the last sheet in Wkb1, replace that line with this...
Rich (BB code): 
Worksheets(1).Copy after:=Wkb1.Worksheets (Wkb1.Worksheets.Count)
 
Upvote 0
Thanks for your help :)

But do you happen to have any ideas on how to solve the problem when Sheets(3) does not exist in the document and i somehow have to run the code below but it will run into error?

Because i have to fulfill the above two situation.

Situation 1: Delete both Sheets(3) and (2) simultaneously when i press the Reset Button.
Situation 2: Delete Sheets(2) upon pressing the Reset Button.

Code: 
If CheckSheet(Sheets(3).Name) Then
Sheets(3).Delete
End If

If CheckSheet(Sheets(2).Name) Then
Sheets(2).Delete
End If

My main bulk of codes here if you want to understand what i want to achieve.
Code: 
Private Sub ComparisonButton_Click()

ComparisonButton.Enabled = False
Call Differences
ResetButton.Enabled = True

End Sub

Private Sub ImportButton1_Click()

Dim OpenFile As Variant
Dim FileName1 As String
CheckBoolean1 = True

If CheckBoolean2 = False Then
    ComparisonButton.Enabled = False
ElseIf CheckBoolean1 = True And CheckBoolean2 = True Then
        ComparisonButton.Enabled = True
End If

'-----------------------------------------------------------------------------
Dim Wkb1 As Workbook
Set Wkb1 = ActiveWorkbook

OpenFile = Application.GetOpenFilename( _
FileFilter:="Excel Files, *.xls; *.csv; *.xlsx", Title:="Importing BOM-List 1")

If OpenFile = False Then
MsgBox "Please Select a BOM-List Excel File"
Exit Sub
Else
Workbooks.Open OpenFile
End If

FileName1 = ActiveWorkbook.Name

Worksheets(1).Copy after:=Wkb1.Worksheets(1)

Workbooks(FileName1).Close SaveChanges:=False

'-----------------------------------------------------------------------------
ImportButton1.Enabled = False
ImportButton2.Enabled = True
ResetButton.Enabled = True
Sheets(1).Activate

End Sub

Private Sub ImportButton2_Click()

Dim OpenFile As Variant
Dim FileName2 As String
CheckBoolean2 = True

If CheckBoolean1 = False Then
    ComparisonButton.Enabled = False
ElseIf CheckBoolean1 = True And CheckBoolean2 = True Then
        ComparisonButton.Enabled = True
End If
'-------------------------------------------------------------------------------
Dim Wkb1 As Workbook
Set Wkb1 = ActiveWorkbook

OpenFile = Application.GetOpenFilename( _
FileFilter:="Excel Files, *.xls; *.csv; *.xlsx", Title:="Importing BOM-List 2")

If OpenFile = False Then
MsgBox "Please Select a BOM-List Excel File"
Exit Sub
Else
Workbooks.Open OpenFile
End If

FileName2 = ActiveWorkbook.Name

Worksheets(1).Copy after:=Wkb1.Worksheets(Wkb1.Sheets.Count)

Workbooks(FileName2).Close SaveChanges:=False

'-------------------------------------------------------------------------------
ImportButton2.Enabled = False
ResetButton.Enabled = True
Sheets(1).Activate

End Sub

Private Sub ResetButton_Click()

ComparisonButton.Enabled = False
ResetButton.Enabled = False

CheckBoolean1 = False
CheckBoolean2 = False

ImportButton1.Enabled = True
ImportButton2.Enabled = False

Application.DisplayAlerts = False

If CheckSheet(Sheets(3).Name) Then
Sheets(3).Delete
End If

If CheckSheet(Sheets(2).Name) Then
Sheets(2).Delete
End If

Application.DisplayAlerts = True

End Sub

Function CheckSheet(ByVal sSheetName As String) As Boolean

    Dim oSheet As Excel.Worksheet
    Dim bReturn As Boolean

    For Each oSheet In ActiveWorkbook.Sheets

        If oSheet.Name = sSheetName Then

            bReturn = True
            Exit For
        End If

    Next oSheet

    CheckSheet = bReturn

End Function
 
Upvote 0
imso said:
But do you happen to have any ideas on how to solve the problem when Sheets(3) does not exist in the document and i somehow have to run the code below but it will run into error?

Because i have to fulfill the above two situation.

Situation 1: Delete both Sheets(3) and (2) simultaneously when i press the Reset Button.
Situation 2: Delete Sheets(2) upon pressing the Reset Button.
Click to expand...

You could replace that code with....
Code: 
With ActiveWorkbook
    If (.Sheets.Count) >= 3 Then .Sheets(3).Delete
    If (.Sheets.Count) >= 2 Then .Sheets(2).Delete
End With
 
Upvote 0
Hi JS411,

It works. But why suddenly why are my comparison module (Module1) which handles the differentiating of part number not working anymore? Did i happen to disable the Find Function? With puzzling result of every single row being highlight red? Thanks for your time and help :)

Sheet1 codes

Code: 
Private Sub ComparisonButton_Click()

ComparisonButton.Enabled = False
Call Differences
ResetButton.Enabled = True

End Sub

Private Sub ImportButton1_Click()

Dim OpenFile As Variant
Dim FileName1 As String
CheckBoolean1 = True

If CheckBoolean2 = False Then
    ComparisonButton.Enabled = False
ElseIf CheckBoolean1 = True And CheckBoolean2 = True Then
        ComparisonButton.Enabled = True
End If

'-----------------------------------------------------------------------------
Dim Wkb1 As Workbook
Set Wkb1 = ActiveWorkbook

OpenFile = Application.GetOpenFilename( _
FileFilter:="Excel Files, *.xls; *.csv; *.xlsx", Title:="Importing BOM-List 1")

If OpenFile = False Then
MsgBox "Please Select a BOM-List Excel File"
Exit Sub
Else
Workbooks.Open OpenFile
End If

FileName1 = ActiveWorkbook.Name

Worksheets(1).Copy after:=Wkb1.Worksheets(1)

Workbooks(FileName1).Close SaveChanges:=False

'-----------------------------------------------------------------------------
ImportButton1.Enabled = False
ImportButton2.Enabled = True
ResetButton.Enabled = True
Sheets(1).Activate

End Sub

Private Sub ImportButton2_Click()

Dim OpenFile As Variant
Dim FileName2 As String
CheckBoolean2 = True

If CheckBoolean1 = False Then
    ComparisonButton.Enabled = False
ElseIf CheckBoolean1 = True And CheckBoolean2 = True Then
        ComparisonButton.Enabled = True
End If
'-------------------------------------------------------------------------------
Dim Wkb1 As Workbook
Set Wkb1 = ActiveWorkbook

OpenFile = Application.GetOpenFilename( _
FileFilter:="Excel Files, *.xls; *.csv; *.xlsx", Title:="Importing BOM-List 2")

If OpenFile = False Then
MsgBox "Please Select a BOM-List Excel File"
Exit Sub
Else
Workbooks.Open OpenFile
End If

FileName2 = ActiveWorkbook.Name

Worksheets(1).Copy after:=Wkb1.Worksheets(Wkb1.Sheets.Count)

Workbooks(FileName2).Close SaveChanges:=False

'-------------------------------------------------------------------------------
ImportButton2.Enabled = False
ResetButton.Enabled = True
Sheets(1).Activate

End Sub

Private Sub ResetButton_Click()

ComparisonButton.Enabled = False
ResetButton.Enabled = False

CheckBoolean1 = False
CheckBoolean2 = False

ImportButton1.Enabled = True
ImportButton2.Enabled = False

Application.DisplayAlerts = False
With ActiveWorkbook
    If (.Sheets.Count) >= 3 Then .Sheets(3).Delete
    If (.Sheets.Count) >= 2 Then .Sheets(2).Delete
End With
Application.DisplayAlerts = True

End Sub

Module1 Sub Differences not working?

Code: 
Public CheckBoolean1 As Boolean
Public CheckBoolean2 As Boolean

Sub SetDefaults()
    CheckBoolean1 = False
    CheckBoolean2 = False
'--------------------------------------------------------

Application.DisplayAlerts = False
With ActiveWorkbook
    If (.Sheets.Count) >= 3 Then .Sheets(3).Delete
    If (.Sheets.Count) >= 2 Then .Sheets(2).Delete
End With
Application.DisplayAlerts = True

'--------------------------------------------------------
End Sub

Sub Differences()
     
    Dim ws2 As Worksheet, ws3 As Worksheet, CompareSheet As Worksheet
    Dim lastRow2 As Integer, lastRow3 As Integer
    Dim rng2 As Range, rng3 As Range, temp As Range, found As Range
     
    Application.ScreenUpdating = False
     
    Set ws2 = ThisWorkbook.Sheets(2)
    Set ws3 = ThisWorkbook.Sheets(3)
     
    lastRow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
    lastRow3 = ws3.Range("A" & Rows.Count).End(xlUp).Row
     
    Set rng2 = ws2.Range("C21:C" & lastRow2)
    Set rng3 = ws3.Range("C21:C" & lastRow3)
     
    For Each temp In rng2
        If temp.Value <> "" Then
            Set found = rng2.Find(What:=temp.Value, LookAt:=xlWhole)
            If found Is Nothing Then
              Set CompareSheet = temp.Worksheet
              CompareSheet.Range("A" & temp.Row, "P" & temp.Row).Interior.ColorIndex = 3
            End If
        End If
    Next temp
     
    For Each temp In rng3
        If temp.Value <> "" Then
            Set found = rng3.Find(What:=temp.Value, LookAt:=xlWhole)
            If found Is Nothing Then
              Set CompareSheet = temp.Worksheet
              CompareSheet.Range("A" & temp.Row, "P" & temp.Row).Interior.ColorIndex = 3
            End If
        End If
    Next temp
     
End Sub

Regards,
imso
 
Upvote 0
imso said:
It works. But why suddenly why are my comparison module (Module1) which handles the differentiating of part number not working anymore? Did i happen to disable the Find Function? With puzzling result of every single row being highlight red?
Click to expand...

Hi imso,

I think your problem is in this part...
Rich (BB code): 
   For Each temp In rng2
        If temp.Value <> "" Then
            Set found = rng2.Find(What:=temp.Value, LookAt:=xlWhole)

It looks like your intent is to compare the two sheets like this...
Rich (BB code): 
   For Each temp In rng2
        If temp.Value <> "" Then
            Set found = rng3.Find(What:=temp.Value, LookAt:=xlWhole)

The same typo occurs on the similar block of code that follows.
(You might want to combine those two blocks into a function that takes ws2 and ws3 as parameters to make the code easier to maintain).
 
Last edited:
Upvote 0
Hi JS411,

It has been great for the past few days for you to answer my queries. Thanks for your time and effort all these while for helping me to answer my questions. Really appreciate it! Cheers :)

Best Regards,
imso
 
Upvote 0
Hi JS411,

Sorry to bring up the topic again but I've kinda been recommended to add improvements. Which i am quite puzzled on how to implement it.

Brief Description:

After running the differences test I'm required to:
1) Create a new sheet
2) Populate the differences of both sheets(2) and (3) into this new sheet via copy/paste onto the new sheet in two sections. Something like a summary chart. (All the Color formats all what so ever formats remain unchanged.)

Regards,
imso
 
Upvote 0
Something like a summary sheet to allow user to quickly differential the differences between both sheets just on a single new sheet created.
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Solved
Macro to speedy up process when copying Data
Replies
3
Views
91
Logit
Logit
D
  • Solved
Merge files and keep source formatting.
Replies
9
Views
349
Alex Blakenburg
A
T
  • Solved
CSV import overwriting the next column after the last one in the CSV file
Replies
7
Views
328
Joe4
Joe4
H
  • Question Question
Macro to Open File and limit selection where files contains "Parts" in C
Replies
4
Views
269
howard
H
H
  • Question Question
Macro to select latest modified File
Replies
4
Views
242
Sektor
Sektor

Forum statistics

Threads
1,224,600
Messages
6,179,834
Members
452,947
Latest member
Gerry_F

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