Array in VBA

[RPT_22]

Hi,

I have this VBA which works but i have 2 questions to change/improve

The code is for a userform to transfer data

1. Instead of using the cells.value = Textbox etc..etc.., how would you change this code to use an array formula for transferring the data
2. Instead of sending the data to this workbook how would i change the code so it sends the data to the following network address: \\Smith\public\OPERATIONS\Group\Recording\data\media_Test
3. Cell C4 is the 1st cell which needs to receive data
Also are there other parts of the code which need improving?

Thank you

Private Sub UserForm_Initialize()
Me.Combobox1_Date.RowSource = ""
Me.Combobox1_Date.List = Application.Transpose(Sheets("Lists").Range("E3:E5").Value)
End Sub

Private Sub CommandButton1_Click()

Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Media_Test")
Dim strDate As String

'find first empty row in database
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

 'check user input
    For Each ctl In Me.Controls
        If ctl.Tag <> vbNullString And ctl.Enabled Then
            If ctl.Value = vbNullString Then MsgBox ctl.Tag: Exit Sub
        End If
    Next
    
With ws
'  .Unprotect Password:="password"
  .Cells(iRow, 2).Value = Me.Combobox1_Date.Value
  .Cells(iRow, 3).Value = TextBox1.Value
  .Cells(iRow, 4).Value = TextBox2.Value
  .Cells(iRow, 5).Value = TextBox3.Value
  .Cells(iRow, 6).Value = TextBox4.Value
  .Cells(iRow, 7).Value = TextBox5.Value
  .Cells(iRow, 8).Value = TextBox6.Value
  .Cells(iRow, 9).Value = ComboBox2.Value
  .Cells(iRow, 10).Value = TextBox7.Value
  .Cells(iRow, 11).Value = TextBox8.Value
 
End With
    
    'Clear all fields
    For Each ctl In Me.Controls
        If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then ctl.Value = vbNullString
          
    Next
    
   MsgBox "Data Transferred"
  
    End Sub


Private Sub CommandButton2_Click()
TextBox1.Value = Split(Now())(1)
End Sub

Private Sub CommandButton3_Click()
TextBox2.Value = Split(Now())(1)
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If MsgBox("Are you sure you want to close?", vbYesNo) = vbNo Then
    Cancel = True
End If
End Sub

 

[RPT_22]

Hi,

Any help would be appreciated

Thank you

 

[RoryA]

To be honest, your questions make no sense to me.
1. What do array formulas have to do with this?
2. What do you mean by this? Do you mean to send the data to a workbook in a network location?
3. I'm not even sure if this is a question?

 

[RPT_22]

Ok….I will try again

1.In my code below I was enquiring if this could be re-written using an array instead of .cells
With ws
' .Unprotect Password:="password"
.Cells(iRow, 2).Value = Me.Combobox1_Date.Value
.Cells(iRow, 3).Value = TextBox1.Value
.Cells(iRow, 4).Value = TextBox2.Value
.Cells(iRow, 5).Value = TextBox3.Value
.Cells(iRow, 6).Value = TextBox4.Value
.Cells(iRow, 7).Value = TextBox5.Value
.Cells(iRow, 8).Value = TextBox6.Value
.Cells(iRow, 9).Value = ComboBox2.Value
.Cells(iRow, 10).Value = TextBox7.Value
.Cells(iRow, 11).Value = TextBox8.Value

2. Yes send to a workbook on network

3. The data when sent over network will end up in workbook called Media_Test

Thank you

 

[RoryA]

1. Assuming you actually want it on the worksheet still, you could use something like:

ws.cells(irow, 2).Resize(, 10).Value = Array(Me.Combobox1_Date.Value, TextBox1.Value, TextBox2.Value, TextBox3.Value, TextBox4.Value, TextBox5.Value, TextBox6.Value, ComboBox2.Value, TextBox7.Value, TextBox8.Value)

2. Yes, you just open that workbook first and then assign the relevant sheet in it to the ws variable. (then save and close it again afterwards presumably)

 

[RPT_22]

Thank you
I had an error "End With without With". Once i deleted the End With then the array worked just fine

Would you have time to help me with the last part
Instead of sending the data to Decay_Test in the current workbook how do i alter the code so the data is sent to another workbook on the network - \\Smith\public\OPERATIONS\Group\Recording\data\media_Test

1. How do i open the workbook Media_Test first and then transfer the data onto the Sheet called "INFO"
2. Once data transferred, then workbook will close

Thank you

Private Sub UserForm_Initialize()
Me.Combobox1_Date.RowSource = ""
Me.Combobox1_Date.List = Application.Transpose(Sheets("Lists").Range("E3:E5").Value)
End Sub

Private Sub CommandButton1_Click()

Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Decay_Test")
Dim strDate As String

'find first empty row in database
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

 'check user input
    For Each ctl In Me.Controls
        If ctl.Tag <> vbNullString And ctl.Enabled Then
            If ctl.Value = vbNullString Then MsgBox ctl.Tag: Exit Sub
        End If
    Next
    
ws.Cells(iRow, 2).Resize(, 10).Value = Array(Me.Combobox1_Date.Value, TextBox1.Value, TextBox2.Value, TextBox3.Value, TextBox4.Value, TextBox5.Value, TextBox6.Value, ComboBox2.Value, TextBox7.Value, TextBox8.Value)

    'Clear all fields
    For Each ctl In Me.Controls
        If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then ctl.Value = vbNullString
          
    Next
    
   MsgBox "Data Transferred"
  
    End Sub


Private Sub CommandButton2_Click()
TextBox1.Value = Split(Now())(1)
End Sub

Private Sub CommandButton3_Click()
TextBox2.Value = Split(Now())(1)
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If MsgBox("Are you sure you want to close?", vbYesNo) = vbNo Then
    Cancel = True
End If
End Sub

 

[RoryA]

You'd replace:

Dim ws As Worksheet
Set ws = Worksheets("Decay_Test")

with:

Dim wb as workbook
set wb = workbooks.open("\\Smith\public\OPERATIONS\Group\Recording\data\media_Test.xlsx")
Dim ws As Worksheet
Set ws = wb.Worksheets("INFO")

then when you're finished with the workbook, just add:

wb.close savechanges:=true

at the relevant point in the code.

 

[RPT_22]

Thank you

 

[RoryA]

Glad we could help.