Posts by dodger7

dodger7 · Dec 3rd 2010

Re: Database

Quote from wanglong1312;528155

It is just awesome, love it.

Thanks

I have a more up to date version, if your still interested let me know and ill open it up and post it

dodger7 · Jul 3rd 2009

Re: Customer Order Summary

Hi Dan

I understand you are new to excel, Dave has a lot of resources on this site which will help you get started. I recommend reading the "Excel Best Practices" article found here:

http://www.ozgrid.com/Excel/ExcelSpreadsheetDesign.htm

then reconsider the design of your order form. There is also "sticky" articles which will always be at the top of this forum, which offers great advice.

Cheers
Jamie

dodger7 · Jun 29th 2009

Re: Compare 2 Tables Of X Columns

Sorry Patsy

just noticed a mistake in the code - I was missing the last line.
Plus, it was using the 1st row. Does your data have headers?
If so, this code is correct:

Code

Option Base 1
 
Sub compare()
     
    Dim ws As Worksheet, lRow
    Dim rowc
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    lRow1 = ws1.Range("F" & Rows.Count).End(xlUp).Address
    rowc = ws1.Range("F2:" & lRow1).Cells.Count
     
    Dim sh1array() As String
    Dim sh2array() As String
    Dim nfarray()
    ReDim nfarray(1)
    ReDim sh1array(2 To rowc + 1)
    ReDim sh2array(2 To rowc + 1)
     
    For i = 2 To rowc + 1
        sh1col1 = ws1.Cells(i, 6).Value
        sh1col2 = ws1.Cells(i, 7).Value
        sh1col3 = ws1.Cells(i, 24).Value
        sh1concat = sh1col1 & sh1col2 & sh1col3
         
        sh1array(i) = sh1concat
         
        sh2col1 = ws2.Cells(i, 21).Value
        sh2col2 = ws2.Cells(i, 22).Value
        sh2col3 = ws2.Cells(i, 23).Value
        sh2concat = sh2col1 & sh2col2 & sh2col3
         
        sh2array(i) = sh2concat
         
    Next i
     
    matchcount = 1
    msgstr = ""
    For k = LBound(sh1array) To UBound(sh1array)
         
        If IsError(Application.Match(sh1array(k), sh2array, 0)) Then
        If IsError(Application.Find(sh1array(k), msgstr, 1)) Then
            
            msgstr = msgstr & sh1array(k) & vbCrLf
            matchcount = matchcount + 1
        End If
        End If
         
    Next k
     
    If matchcount = 1 Then MsgBox "All found in sheet2" Else MsgBox msgstr & vbCrLf & "not found"
     
     
End Sub

Display More

if you dont have headers and want to compare the first line, this should be OK

Code

Option Base 1
 
Sub compare()
     
    Dim ws As Worksheet, lRow
    Dim rowc
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    lRow1 = ws1.Range("F" & Rows.Count).End(xlUp).Address
    rowc = ws1.Range("F1:" & lRow1).Cells.Count
     
    Dim sh1array() As String
    Dim sh2array() As String
    Dim nfarray()
    ReDim nfarray(1)
    ReDim sh1array(1 To rowc)
    ReDim sh2array(1 To rowc)
     
    For i = 1 To rowc
        sh1col1 = ws1.Cells(i, 6).Value
        sh1col2 = ws1.Cells(i, 7).Value
        sh1col3 = ws1.Cells(i, 24).Value
        sh1concat = sh1col1 & sh1col2 & sh1col3
         
        sh1array(i) = sh1concat
         
        sh2col1 = ws2.Cells(i, 21).Value
        sh2col2 = ws2.Cells(i, 22).Value
        sh2col3 = ws2.Cells(i, 23).Value
        sh2concat = sh2col1 & sh2col2 & sh2col3
         
        sh2array(i) = sh2concat
         
    Next i
     
    matchcount = 1
    msgstr = ""
    For k = LBound(sh1array) To UBound(sh1array)
         
        If IsError(Application.Match(sh1array(k), sh2array, 0)) Then
        If IsError(Application.Find(sh1array(k), msgstr, 1)) Then
            
            msgstr = msgstr & sh1array(k) & vbCrLf
            matchcount = matchcount + 1
        End If
        End If
         
    Next k
     
    If matchcount = 1 Then MsgBox "All found in sheet2" Else MsgBox msgstr & vbCrLf & "not found"
     
     
End Sub

Display More

Jamie

dodger7 · Jun 29th 2009

Re: Compare 2 Tables Of X Columns

Hi Patsys

added a find function to check if missing already exists. Should remove duplicates:

Code

Option Base 1
 
Sub compare()
     
    Dim ws As Worksheet, lRow
    Dim rowc
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    lRow1 = ws1.Range("F" & Rows.Count).End(xlUp).Address
    rowc = ws1.Range("F2:" & lRow1).Cells.Count
     
    Dim sh1array() As String
    Dim sh2array() As String
    Dim nfarray()
    ReDim nfarray(1)
    ReDim sh1array(1 To rowc)
    ReDim sh2array(1 To rowc)
     
    For i = 1 To rowc
        sh1col1 = ws1.Cells(i, 6).Value
        sh1col2 = ws1.Cells(i, 7).Value
        sh1col3 = ws1.Cells(i, 24).Value
        sh1concat = sh1col1 & sh1col2 & sh1col3
         
        sh1array(i) = sh1concat
         
        sh2col1 = ws2.Cells(i, 21).Value
        sh2col2 = ws2.Cells(i, 22).Value
        sh2col3 = ws2.Cells(i, 23).Value
        sh2concat = sh2col1 & sh2col2 & sh2col3
         
        sh2array(i) = sh2concat
         
    Next i
     
    matchcount = 1
    msgstr = ""
    For k = LBound(sh1array) To UBound(sh1array)
         
        If IsError(Application.Match(sh1array(k), sh2array, 0)) Then
        If IsError(Application.Find(sh1array(k), msgstr, 1)) Then
            
            msgstr = msgstr & sh1array(k) & vbCrLf
            matchcount = matchcount + 1
        End If
        End If
         
    Next k
     
    If matchcount = 1 Then MsgBox "All found in sheet2" Else MsgBox msgstr & vbCrLf & "not found"
     
     
End Sub

Display More

dodger7 · Jun 26th 2009

Re: Compare 2 Tables Of X Columns

Hi Patsy

try

Code

Option Base 1
    
    Sub compare()


    Dim ws As Worksheet, lRow
    Dim rowc
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    lRow1 = ws1.Range("F" & Rows.Count).End(xlUp).Address
    rowc = ws1.Range("F2:" & lRow1).Cells.Count


    Dim sh1array() As String
    Dim sh2array() As String
    Dim nfarray()
    ReDim nfarray(1)
    ReDim sh1array(1 To rowc)
    ReDim sh2array(1 To rowc)
    
    For i = 1 To rowc
    sh1col1 = ws1.Cells(i, 6).Value
    sh1col2 = ws1.Cells(i, 7).Value
    sh1col3 = ws1.Cells(i, 24).Value
    sh1concat = sh1col1 & sh1col2 & sh1col3
          
     sh1array(i) = sh1concat


    sh2col1 = ws2.Cells(i, 21).Value
    sh2col2 = ws2.Cells(i, 22).Value
    sh2col3 = ws2.Cells(i, 23).Value
    sh2concat = sh2col1 & sh2col2 & sh2col3
    
    sh2array(i) = sh2concat
    
    Next i
    
        matchcount = 1
        msgStr = ""
    For k = LBound(sh1array) To UBound(sh1array)


If IsError(Application.Match(sh1array(k), sh2array, 0)) Then


msgStr = msgStr & sh1array(k) & vbCrLf


matchcount = matchcount + 1
End If
    
     Next k
    
If matchcount = 1 Then MsgBox "All found in sheet2" Else MsgBox msgStr & vbCrLf & "not found"




End Sub

Display More

dodger7 · Jun 26th 2009

Re: Compare 2 Tables Of X Columns

Hi Patsy

The following code should do what you want:

Code

Option Base 1
    
Sub compare()


    Dim ws As Worksheet, lRow
    Dim rowc
    
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    
    lRow1 = ws1.Range("F" & Rows.Count).End(xlUp).Address
    rowc = ws1.Range("F2:" & lRow1).Cells.Count


    Dim sh1array() As String
    Dim sh2array() As String
    ReDim sh1array(1 To rowc)
    ReDim sh2array(1 To rowc)
    
        For i = 1 To rowc
            sh1col1 = ws1.Cells(i, 6).Value
            sh1col2 = ws1.Cells(i, 7).Value
            sh1col3 = ws1.Cells(i, 24).Value
            sh1concat = sh1col1 & sh1col2 & sh1col3
          
            sh1array(i) = sh1concat


            sh2col1 = ws2.Cells(i, 21).Value
            sh2col2 = ws2.Cells(i, 22).Value
            sh2col3 = ws2.Cells(i, 23).Value
            sh2concat = sh2col1 & sh2col2 & sh2col3
    
            sh2array(i) = sh2concat
    
        Next i
    
    matchcount = 0
        
        For k = LBound(sh1array) To UBound(sh1array)


        If IsError(Application.Match(sh1array(k), sh2array, 0)) Then 'if not found
            MsgBox sh1array(k) & " Not found"
            matchcount = matchcount + 1
        End If
    
        Next k
    
        If matchcount = 0 Then MsgBox "All found in sheet2"


End Sub

Display More

The code uses the last row in column F as the row count. I attach an example for you.

There may be more elegant replies to your question, but it works

HTH
Jamie

dodger7 · Jun 24th 2009

Re: User Defined Function Not Updating Cell Content

try placing the following code in the "thisworkbook" module:

Code

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim F As Variant
If SaveAsUI = True Then
Cancel = True
F = Application.GetSaveAsFilename(Me.Name, _
"Workbook (*.xls), *.xls")
If F = False Then Exit Sub
Me.SaveAs CStr(F)
Application.Calculate
End If
Me.Save
Application.Calculate
End Sub

Display More

HTH
Jamie

dodger7 · Jun 23rd 2009

Re: Use Color Cell In The Formula

good point AAE, here is a .xls version.

dodger7 · Jun 23rd 2009

Re: Use Color Cell In The Formula

thanks for the example. Is it always just one bank price per group that is coloured?

dodger7 · Jun 23rd 2009

Re: Use Color Cell In The Formula

could you post an example please?

ADDED BY ADMIN

try this formula: =G9+MIN(H6:J6)

By AAE.

dodger7 · Jun 23rd 2009

Re: Extract Certain Data Based On Conditions

Hi Ben

Really simple - sorry never realised that you wanted headers in that specific position. Just change the line

Code

lrow = ws2.Cells(65535, c).End(xlUp).Offset(1, 0).Address

to

Code

lrow = ws2.Cells(65535, c-2).End(xlUp).Offset(1, 0).Address

and it should work fine. Example attached.
This is presuming your headers will be in the position of the first spreadsheet you attached.
If you headers are going to change position, please let me know.

Hope this helps
Jamie

dodger7 · Jun 23rd 2009

Re: Rotate Image

Thanks, Ger!
Pretty intense coding for something which seems so simple, also equally impressive!

Thanks for sharing

dodger7 · Jun 23rd 2009

Re: Extract Certain Data Based On Conditions

Hi Ben

by moving the headers in your results sheet to the same positions as they are in the data sheet, the following code should work for you.

Code

Sub run()


Dim ws As Worksheet
Dim ws2 As Worksheet


Set ws = Sheet11
Set ws2 = Sheet1


For r = 5 To 194
For c = 5 To 35


lrow = ws2.Cells(65535, c).End(xlUp).Offset(1, 0).Address


val1 = ws.Cells(r, c).Value
If IsNumeric(val1) Then
    If val1 > 0 Then
        ws2.Range(lrow).Value = ws.Cells(r, 3).Value
    End If
End If


Next c
Next r


End Sub

Display More

I attach a working example for your reference.
Hope this helps
Jamie

dodger7 · Jun 23rd 2009

Hi Folks

Pretty useless, however good for a bit fun. Make an image rotate.

Not the greatest thing in the world, however just spent 6 months in hospital so its a foot back in the Excel door!

Enjoy

dodger7 · Aug 22nd 2008

G'day people

I have the following loop set up:

Code

Private Sub CommandButton2_Click()




    Dim counter1 As Long
    Dim myFrame As MSForms.Control


     
    For counter1 = 1 To 30
         
        Set myFrame = Me.Controls("Frame" & counter1)
         
        Dim objControl As Control
         
        For Each objControl In myFrame.Controls
             
            If objControl.Value Then
                 myframe1result = objControl.Caption
                Exit For
            End If
        Next
    Next counter1
    
    
End Sub

Display More

However during each loop "myframeresult" is overwritten. I need to increment this to "myframe2result", "myframe3result" etc for each loop so that each is stored in a separate variable.

Thanks

dodger7 · Aug 21st 2008

Re: Working With Multiple Userforms

cheers mate ill give it a go.

dodger7 · Aug 21st 2008

Sorry the title was meant to be working with multiple frames but I dont know how to edit this

Hi guys

Ive got a userform with 30 frames on it. In each frame there is 5 option buttons with captions 1 2 3 4 and 5)

ive written some code to find out which optionbutton has been chosen for a frame as below

Code

sub commandbutton1_click()
    Dim objControl As Control
     
    For Each objControl In Frame1.Controls
        If objControl.Value = True Then
        
        frame1ans = objControl.Caption
        
            Exit For
        End If
    Next


End Sub

Display More

I was wondering if there was a way to alter the code to do this for each frame, rather than typing it out 30 times?
something like:

Code

sub commandbutton1_click()


For counter1 = 1 To 30


myframe = "Frame" & counter1
myframeresult = "myframeres" & counter1


  Dim objControl As Control
     
    For Each objControl In myframe.Controls
        If objControl.Value = True Then
        
         myframeresult = objControl.Caption
        
            Exit For
        End If
    Next


    Next counter1


end sub

Display More

I know this syntax is all wrong but just to give an idea of what im tryign to do

Thanks in advance
Jamie

dodger7 · Aug 15th 2008

Re: Macro To Insert A New Row

In this example I have a named range "stats" which is the first cell in column A where the stats/percentages start.

put this code behind the SHEET rather than in a module

Code

Private Sub Worksheet_Change(ByVal Target As Range)


If Sheet1.Range("Stats").Offset(-1, 0).Value > "" Then
     Sheets("Sheet1").Range("Stats").EntireRow.Select
    Selection.Insert Shift:=xlDown
End If




End Sub

Display More

dodger7 · Aug 14th 2008

Re: Automatic Filtering Of Drop Down Menu

Hi

Example attached for you. all your lists are on a separate sheet (sheet 2) to keep things tidy.
You can easily add to the lists and the drop down boxes will automatically populate as the ranges are dynamic.

Hope this helps
Jamie

dodger7 · Aug 13th 2008

Re: Inserting A New Row With Updating Data

do you mean a button to do it?

If so something like:

Code

Sub Button2_Click()
    Sheets("Sheet1").Range("A10").Select
    Selection.Insert Shift:=xlDown
End Sub

where "A10" is the first row of your stats/percentages. This will shift all cells from A10 downwards and insert a row.

Posts by dodger7

Database

Summarize Customer Order Data

Compare 2 Tables Of X Columns

Compare 2 Tables Of X Columns

Compare 2 Tables Of X Columns

Compare 2 Tables Of X Columns

Get Time & Date Of Last Update Of Source File

Add Cell Value To Minimum Value Of Range

Add Cell Value To Minimum Value Of Range

Add Cell Value To Minimum Value Of Range

Extract Certain Data Based On Conditions

Rotate Image

Extract Certain Data Based On Conditions

Rotate Image

Increment Variable Control Name

Change Caption On Multiple Frames On UserForm

Change Caption On Multiple Frames On UserForm

Macro To Insert A New Row

Fill Drop Down Based On Choice From Another

Macro To Insert A New Row