PDA

View Full Version : Solved: Can these 2 VBA's be combined



Toonies
09-10-2011, 08:07 AM
Hi and thank you for looking at my post

I have the found the following VBA code and amended it, which works on 2 sheets, but it only puts the data 1 sheet at a time using 2 separate forms.

What I am trying to do is for the VBA to put the data on both sheets at the same time but only using 1 form.

I have tried to amend the VBA code but I am hitting a http://www.mrexcel.com/forum/images/smilies/icon_banghead.gif.

the two ranges "B6:B45" on both sheets have exactly the same list in the same order?


Private Sub UserForm_Initialize()
Dim Dys As Integer
Dim n As Integer
Dim Dt As Date
Dys = DateValue("1/1/" & Year(Now)) - DateValue("1/1/" & (Year(Now) - 1))
ReDim Ray(1 To Dys)
Dt = "1/1/" & Year(Now)
For n = 1 To Dys
Ray(n) = IIf(n = 1, Dt, DateAdd("d", 1, Dt))
Dt = Ray(n)
Next n
Me.ComboBox1.List = Application.Transpose(Ray)
Me.ComboBox2.List = Application.Transpose(Ray)
nameBox1.List = Worksheets("January-June").Range("B6:B45").Value
End Sub
Private Sub UserForm_Initialise()
Dim Dys As Integer
Dim n As Integer
Dim Dt As Date
Dys = DateValue("1/1/" & Year(Now)) - DateValue("1/1/" & (Year(Now) - 1))
ReDim Ray(1 To Dys)
Dt = "1/1/" & Year(Now)
For n = 1 To Dys
Ray(n) = IIf(n = 1, Dt, DateAdd("d", 1, Dt))
Dt = Ray(n)
Next n
Me.ComboBox1.List = Application.Transpose(Ray)
Me.ComboBox2.List = Application.Transpose(Ray)
nameBox1.List = Worksheets("July - December").Range("B6:B45").Value
End Sub
I have posted this question at
http://www.mrexcel.com/forum/showthread.php?t=577919
I did ask a similar question a few days earlier but this is more specific
the previous link is
http://www.vbaexpress.com/forum/showthread.php?t=38930
I look forward to any help or suggestions
Toonies

Toonies
09-12-2011, 10:42 AM
Bump


I have tried several combinations with

With Worksheets("January-June")
End With
With Worksheets("July - December")
End With

placed in different parts of the code???

I am open to any pointers

Toonies

Rob342
09-13-2011, 12:21 PM
Toonies
Can you post a copy of your Workbook

Rob342

Toonies
09-13-2011, 11:09 PM
Hi Rob

many thanks for looking

Here is a copy of the workbook

the password is abc

it is the VBA in UserForm1 that I am trying to alter

6586

Toonies

Toonies
09-14-2011, 04:14 PM
Bump

Rob342
09-15-2011, 01:18 AM
Adam
Try this, a bit brute force but works ok
You might want to put your employees into a dynamic array this way you could probably shorten some of the code and you wouldn't have to keep amending the range B6:B45. Just a thought.
Only use userform1, take a copy 1st ok
Code

Private Sub CommandButton1_Click()
Dim Rng As Range, Dn As Range
Dim sDt As Date
Dim eDt As Date
Dim Ac As Integer
Dim col As Integer
Dim ws As Worksheet
Dim N As Integer

Application.ScreenUpdating = False
Set ws = Worksheets("January-June")

With ws
For N = 1 To 2
Set Rng = Range(Range("B6"), Range("B" & Rows.Count).End(xlUp))
sDt = ComboBox1
eDt = ComboBox2

Select Case True
Case Is = holidaybutton1: col = 43
Case Is = sickLeavebutton3: col = 53
Case Is = otherOptionButton4: col = 37
Case Is = deleteRecordbutton5: col = 0
End Select

For Each Dn In Rng
If Dn = nameBox1 Then
For Ac = 1 To 184 ' Change to 184
If Cells(4, Ac + 2) >= sDt And Cells(4, Ac + 2) <= eDt Then
If Weekday(Cells(4, Ac + 2), vbMonday) < 6 Then
If IsError(Application.Match(Cells(4, Ac + 2), Range("PUBLICHOLIDAY"), 0)) Then
Dn.Offset(, Ac).Interior.ColorIndex = col
End If
End If
End If
Next Ac
End If
Next Dn

Set ws = Worksheets("July-December")
ws.Activate
Ac = 1
Next N
End With
Set ws = Worksheets("January-June")
ws.Select
Application.ScreenUpdating = True
Unload Me
End Sub

Toonies
09-15-2011, 03:01 PM
Hi Rob your a "STAR"

:thumb

it worked great

and you made it look so easy

I will look putting the employees into a dynamic array
:beerchug:
many thanks

Toonies