Multi Ranges on same Sheet

IJQ

New Member
Joined
Aug 28, 2005
Messages
31
Hi

I have a sheet named DB which contains many named ranges, such as Earth_DB, Concrete_DB, Blocks_DB etc.... I have a UserForm to add info to each range, using CheckBox buttons as the code shows below. However I Can't seem to properly do it because once I click the Add button the info is not sent to the specific range, but is sent randomly Any Help would be great
CODE:

Option Explicit

Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("DB")
Dim Rng1, Rng2, Rng3, Rng4 As Range
Set Rng1 = ws.Range("EarthWorks_DB")
Set Rng2 = ws.Range("Concrete_DB")
Set Rng3 = ws.Range("Stones_DB")
Set Rng4 = ws.Range("Blocks_DB")
'find first empty row in database
With CheckBox1 = True
iRow = Rng1.Cells(Rows.Count).End(xlUp).Offset(1, 0).Row
'copy the data to the database
Rng1.Cells(iRow, 1).Value = Me.TxtName.Value
Rng1.Cells(iRow, 2).Value = Me.TxtQty.Value
Rng1.Cells(iRow, 3).Value = Me.TxtMaterial.Value
Rng1.Cells(iRow, 4).Value = Me.TxtLabor.Value
Rng1.Cells(iRow, 5).Value = Me.TxtSC.Value
Rng1.Cells(iRow, 6).Value = Me.TxtEquip.Value

End With
With CheckBox2 = True
iRow = Rng2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'copy the data to the database
Rng2.Cells(iRow, 1).Value = Me.TxtName.Value
Rng2.Cells(iRow, 2).Value = Me.TxtQty.Value
Rng2.Cells(iRow, 3).Value = Me.TxtMaterial.Value
Rng2.Cells(iRow, 4).Value = Me.TxtLabor.Value
Rng2.Cells(iRow, 5).Value = Me.TxtSC.Value
Rng2.Cells(iRow, 6).Value = Me.TxtEquip.Value

End With

can this be done any simpler?
IJQ
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Hello IJQ,
A couple of things to note.
(1) When you dimension your variables like so:
Dim Rng1, Rng2, Rng3, Rng4 As Range
You are actually defining Rng4 as a data type Range, but Rng1, Rng2 & Rng3 are not specified so by default they are getting assigned as a data type Variant.
You must specify each data type for each variable even if they are to be the same type. (You'd think the way you had it written it would define them all as Range but unfortunately it doesn't work that way.) In this case it wouldn't cause any noticeable difference, but in your future programming it's bound to come up.

(2) When you refer to a named range in VBA, it actually only refers to the first (upper leftmost) cell in that range, and that can cause unexpected results if one thinks the entire range is being referred to.

If I understand what your code is intended to do than you might give one of these a shot.

If you’ll ever have more than one of the checkboxes ticked at one time then…
Code:
Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Dim Rng1 As Range, Rng2 As Range
Dim Rng3 As Range, Rng4 As Range

Set ws = Worksheets("DB")
Set Rng1 = ws.Range("EarthWorks_DB")
Set Rng2 = ws.Range("Concrete_DB")
Set Rng3 = ws.Range("Stones_DB")
Set Rng4 = ws.Range("Blocks_DB")

If CheckBox1 Then
    With Rng1
        'find first empty row in range "EarthWorks_DB"
        iRow = .Row + .Rows.Count
        iRow = Cells(iRow, 1).End(xlUp)(2, 1).Row
        'copy the data to range "EarthWorks_DB"
        Cells(iRow, 1).Value = Me.TxtName.Value
        Cells(iRow, 2).Value = Me.TxtQty.Value
        Cells(iRow, 3).Value = Me.TxtMaterial.Value
        Cells(iRow, 4).Value = Me.TxtLabor.Value
        Cells(iRow, 5).Value = Me.TxtSC.Value
        Cells(iRow, 6).Value = Me.TxtEquip.Value
    End With
End If

If CheckBox2 Then
    With Rng2
        'find first empty row in range "Concrete_DB"
        iRow = .Row + .Rows.Count
        iRow = Cells(iRow, 1).End(xlUp)(2, 1).Row
        'copy the data to range "Concrete_DB"
        Cells(iRow, 1).Value = Me.TxtName.Value
        Cells(iRow, 2).Value = Me.TxtQty.Value
        Cells(iRow, 3).Value = Me.TxtMaterial.Value
        Cells(iRow, 4).Value = Me.TxtLabor.Value
        Cells(iRow, 5).Value = Me.TxtSC.Value
        Cells(iRow, 6).Value = Me.TxtEquip.Value
    End With
End If

If CheckBox3 Then
    With Rng3
        'find first empty row in range "Stones_DB"
        iRow = .Row + .Rows.Count
        iRow = Cells(iRow, 1).End(xlUp)(2, 1).Row
        'copy the data to range "Stones_DB"
        Cells(iRow, 1).Value = Me.TxtName.Value
        Cells(iRow, 2).Value = Me.TxtQty.Value
        Cells(iRow, 3).Value = Me.TxtMaterial.Value
        Cells(iRow, 4).Value = Me.TxtLabor.Value
        Cells(iRow, 5).Value = Me.TxtSC.Value
        Cells(iRow, 6).Value = Me.TxtEquip.Value
    End With
End If

End Sub
If you'll NEVER have more than one checkbox ticked at one time then (I'd consider using radiobuttons (or optionbuttons) instead) and you can make it (perhaps) a bit simpler with this...
Code:
Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Dim Rng1 As Range, Rng2 As Range
Dim Rng3 As Range, Rng4 As Range

Set ws = Worksheets("DB")
Set Rng1 = ws.Range("EarthWorks_DB")
Set Rng2 = ws.Range("Concrete_DB")
Set Rng3 = ws.Range("Stones_DB")
Set Rng4 = ws.Range("Blocks_DB")

With Me
  If .CheckBox1 Then
    With Rng1
        iRow = .Row + .Rows.Count
        iRow = Cells(iRow, 1).End(xlUp)(2, 1).Row
    End With
  ElseIf .CheckBox2 Then
    With Rng2
        iRow = .Row + .Rows.Count
        iRow = Cells(iRow, 1).End(xlUp)(2, 1).Row
    End With
  ElseIf .CheckBox3 Then
    With Rng3
        iRow = .Row + .Rows.Count
        iRow = Cells(iRow, 1).End(xlUp)(2, 1).Row
    End With
  End If
End With

On Error GoTo ET
Cells(iRow, 1).Value = Me.TxtName.Value
Cells(iRow, 2).Value = Me.TxtQty.Value
Cells(iRow, 3).Value = Me.TxtMaterial.Value
Cells(iRow, 4).Value = Me.TxtLabor.Value
Cells(iRow, 5).Value = Me.TxtSC.Value
Cells(iRow, 6).Value = Me.TxtEquip.Value
Exit Sub
    
ET:
MsgBox "No checkbox was ticked so no entry was made.", , "No Entry Made"
On Error GoTo 0

End Sub
Hope it helps.
 
Upvote 0

Forum statistics

Threads
1,207,205
Messages
6,077,045
Members
446,252
Latest member
vettaforza

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