I have a some part of the codes of a macro it's working below changing of the cell value. But I want to replace them as linking a command button + getting data from a closed workbook. Can someone help me about re-edit them?
Thank you for help!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Chck As Integer, Cnt As Integer
Dim Save As String
Dim Subjt As Integer
If Not Intersect(Range("A1"), Target) Is Nothing And Not Target = "" Then
With Workbooks("Data2.xlsm").Worksheets("Datas")
Application.EnableEvents = False
Worksheets("Sheet1").Cells.Clear
For Chck = 2 To .Cells(Rows.Count, "C").End(xlUp).Row
Select Case .Cells(Chck, "C")
Case "Number"
Subjt = Chck
Case ""
If Save <> "" Then
Save = "C" & Subjt & ":Q" & Subjt & Save
.Range(Save).Copy
Cnt = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
If Cnt > 1 Then Cnt = Cnt + 2
Worksheets("Sheet1").Range("A" & Cnt).PasteSpecial
Save = ""
End If
Case Target
If .Cells(Chck, "B") = "Number" Then Save = Save & ", C" & Chck & ":Q" & Chck
End Select
Next
Application.EnableEvents = True
End With
End If
End Sub
Try this in a regular module:
EDIT: made a few fixes
Sub CopyDataValues()
Dim Chck As Long, Cnt As Long
Dim Save As String
Dim Subjt As Long, valA1
Dim ws1 As Worksheet, wsData As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set wsData = Workbooks("Data2.xlsm").Worksheets("Datas")
Cnt = ws1.Range("A" & Rows.Count).End(xlUp).Row
Cnt = Cnt + 2
valA1 = ws1.Range("A1").Value
If Len(valA1) > 0 Then
With wsData
Application.EnableEvents = False
'ws1.Cells.Clear
For Chck = 2 To .Cells(Rows.Count, "C").End(xlUp).Row
Select Case .Cells(Chck, "C")
Case "NUMBER"
Subjt = Chck
Case ""
If Save <> "" Then
Save = "C" & Subjt & ":Q" & Subjt & Save
.Range(Save).Copy ws1.Range("A" & Cnt)
Cnt = Cnt + 2
Save = ""
End If
Case valA1
If .Cells(Chck, "B") = "REAL" Then
Debug.Print "matched " & valA1 & " on row " & Chck
Save = Save & ", C" & Chck & ":Q" & Chck
End If
End Select
Next
Application.EnableEvents = True
End With
End If
End Sub
Change Private Sub to Sub only and assign the macro to your related button.
For the workbook first, you have to create an excel object to get the closed workbook in it.
Related
I want to create a userform with inputs: Name (TextBox1), Surname (TextBox2), Date of birth (TextBox3) and 1 output which would basically be their ID (goes from 1 to inf). What bothers me is that I want to code that if lets say Name and Surname already exists in database, msg will popup and form will reset else everything will be put to the table. I kind of managed to do that. Problem is now if I do put name and surname that already exists it wont input it in the table and it will show the message, but even if it doesn't exists the message will still pop up but it will input it in the table. This is the code:
Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Sheet2
Dim a As Integer
Application.ScreenUpdating = False
iRow = ws.Range("A1048576").End(xlUp).Row + 1
If Not (TextBox1.Text = "" Or TextBox2.Text = "" Or TextBox3.Text = "") Then
With ws
Label1.Caption = iRow - 1
For a = 1 To iRow
If (ws.Cells(a, 2).Value = TextBox1.Value And ws.Cells(a, 3).Value = TextBox2.Value) Then
MsgBox "Values you entered already exists!"
Call Reset
Exit Sub
Else
.Range("A" & iRow).Value = Label1.Caption
.Range("B" & iRow).Value = TextBox1.Value
.Range("C" & iRow).Value = TextBox2.Value
.Range("D" & iRow).Value = TextBox3.Value
End If
Next a
End With
End If
Application.ScreenUpdating = True
End Sub
The problem is you are checking down to the row where the new record is inserted. So for every row that does not match the new record is inserted at iRow. When the loop gets to the end it checks iRow, matches and shows the message. Separate code into 2 steps, first check then update or reset.
Private Sub CommandButton1_Click()
If TextBox1.Text = "" Or TextBox2.Text = "" Or TextBox3.Text = "" Then
Exit Sub
End If
Dim ws As Worksheet
Dim iRow As Long, r As Long, bExists As Boolean
Set ws = Sheet2
iRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
' check exists
For r = 1 To iRow
If (ws.Cells(r, 2).Value = TextBox1.Value) _
And (ws.Cells(r, 3).Value = TextBox2.Value) Then
bExists = True
Exit For
End If
Next
' update sheet
If bExists Then
MsgBox "Values you entered already exists!"
Call Reset
Exit Sub
Else
Label1.Caption = iRow
iRow = iRow + 1
With ws
.Range("A" & iRow).Value = Label1.Caption
.Range("B" & iRow).Value = TextBox1.Value
.Range("C" & iRow).Value = TextBox2.Value
.Range("D" & iRow).Value = TextBox3.Value
End With
End If
End Sub
Below is a code that I am now using to automatically insert numbers to a cell that has todays date on Column A and the correct name on the first row of that column.
However, I can't seem to make it work if the names are in any other row than 1.
What changes do I need to make if I want it to search matches on row 2 or multiple rows?
Sub SyöttöEriVälilehti()
Application.ScreenUpdating = False
On Error GoTo M
Dim i As Long
Dim Lastrow As Long
Dim col As Long
col = 0
Dim LastColumn As Long
Dim DateLastrow As Long
Dim ans As String
Dim LString As String
Dim LArray() As String
Dim anss As String
Dim ansss As String
With Sheets("Malli2Data") ' Sheet name
DateLastrow = .Cells(Rows.Count, "A").End(xlUp).Row
Set SearchRange = .Range("A1:A" & DateLastrow).Find(Date)
If SearchRange Is Nothing Then MsgBox Date & " No matches", , "Oops!": Exit Sub
Lastrow = SearchRange.Row
LastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
ans = InputBox("Input name and number like so: Tom,5")
LString = ans
LArray = Split(LString, ",")
anss = LArray(0)
ansss = LArray(1)
For i = 2 To LastColumn
If .Cells(1, i).Value = anss Then col = Cells(1, i).Column
Next
If col = 0 Then MsgBox anss & " No matches": Exit Sub
.Cells(Lastrow, col).Value = ansss
End With
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "Error" & vbNewLine _
& "Check input" & _
vbNewLine & "You typedt: " & ans & vbNewLine & "Correct input type: " & vbNewLine & "Name" & ",Number" & _
vbNewLine & vbNewLine & "Try again"
End Sub
The snippet:
For i = 2 To LastColumn
If .Cells(1, i).Value = CDec(anss) Then col = Cells(1, i).Column
Next
Is searching row 1 for your name
If you want to change it and make it a variable, something like
For i = 2 To LastColumn
If .Cells(xRow, i).Value = CDec(anss) Then col = Cells(1, i).Column
Next
With xRow being your defined row to search will work.
At the same time, you could sub out the last bit within the loop and use
For i = 2 To LastColumn
If .Cells(xRow, i).Value = CDec(anss) Then col = i
Next
As they are the same thing.
edit 20201-04-23A: Use of CDec(anss) will convert the string (as gathered from "ans") into a decimal number - which can then be compared against the .Value taken out of the cell.
the macro below takes two cell values (from first and second column)
and displays the column and there cell content in a Pop up Form
Im trying to add the condition that only the column and cell value is displayed if the cell contains value.
something like that =IF(A1<>"",result,"")
but I dont know how to implement that for all cells not only for a specific one.
Option Explicit
Const rangeForSearch = "G2"
Const rowTitles = 4
Dim arrTmp
Dim lastRow As Long, lastColumn As Long
Dim textForSearch As String, textForSearch_withoutSpaces As String
Dim strTmp As String
Dim i As Long, j As Long
Sub searchPerson()
Application.ScreenUpdating = False
With ActiveSheet
textForSearch = .Range(rangeForSearch)
If textForSearch = "" Then
MsgBox "Input text in cell """ & rangeForSearch & """ and try again!", vbCritical
Application.ScreenUpdating = True
Exit Sub
End If
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
lastColumn = .Cells(rowTitles, .Columns.Count).End(xlToLeft).Column
If lastRow <= rowTitles Or lastColumn <= 2 Then
MsgBox "Dataset is wrong! Check it and try again!", vbCritical
Application.ScreenUpdating = True
Exit Sub
End If
arrTmp = .Range(.Cells(rowTitles, "A"), .Cells(lastRow, lastColumn))
End With
'---------------------------------------
textForSearch_withoutSpaces = Replace(textForSearch, " ", "")
For i = LBound(arrTmp, 1) + 1 To UBound(arrTmp, 1)
strTmp = Replace(arrTmp(i, 1) & arrTmp(i, 2), " ", "")
If StrComp(textForSearch_withoutSpaces, strTmp, vbTextCompare) = 0 Then Exit For
Next i
If i = UBound(arrTmp, 1) + 1 Then
strTmp = textForSearch & vbCrLf & vbCrLf & "No dataset!"
Else
strTmp = textForSearch
For j = 3 To lastColumn
strTmp = strTmp & vbCrLf & vbCrLf & arrTmp(1, j) & ": " & arrTmp(i, j)
Next j
End If
Application.ScreenUpdating = True
MsgBox strTmp, , "Result"
End Sub
maybe
For j = 3 To lastColumn
If Not IsEmpty(arrTmp(i, j)) Then strTmp = strTmp & vbCrLf & vbCrLf & arrTmp(1, j) & ": " & arrTmp(i, j)
Next j
Sub Button1_Click()
Dim Data1 As String
Dim Data2 As String
Dim sFinal As String
Dim sLeft As String
Dim sRight As String
'For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
Data1 = Range("A1").Value
Data2 = "-"
sLeft = Left(Data1, 2)
sRight = Right(Data1, Len(Data1) - 2)
sFinal = sLeft & Data2 & sRight
Range("A1").Value = sFinal
'Next i
End Sub
I am trying to loop trough values of column A to insert "-" after two characters in every cells... but my "For Next i" loop has error, how can I fix it?
This is better:
Sub Button1_Click()
Dim i As Long
Application.ScreenUpdating = False
i = 1
Do Until i > Range("A1048576").End(xlUp).Row
Range("A" & i).Value = Left(Trim(Range("A" & i).Value), 2) & "-" & Right(Trim(Range("A" & i).Value), Len(Trim(Range("A" & i).Value)) - 2)
i = i + 1
Loop
Application.ScreenUpdating = True
End Sub
I have had to open a new question following a previous question i had to decrease and increment a number which is on the link bellow
Changing VBA macro code to change number
this is the code that i am trying to work with and i got it almost to work but somewhere its gone wrong.
Bulkwks.[B5] is M20
historywks.[a2] is the time
historywks.[b2] is the name
historywks.[C2] is m201001
Sub bulkON_Click()
Dim trnwkbk As Workbook
Dim Bulkwks As Worksheet
Dim Deswkbk As Workbook
Dim LogNum As Range, LastNum, NewNum,
Dim historywks As Worksheet
Dim nextRow As Long
Dim lOR As Long
Dim myIn As String
Dim myLeft As String
Dim myMid As Integer, myRight As Integer, i As Integer
Dim myOut As String
Set trnwkbk = Workbooks("Transport.xls")
Set Bulkwks = trnwkbk.Worksheets("Bulk")
lOR = MsgBox("Have you selected the right MIS or HUB or PSA number?", vbQuestion + vbYesNo, "Number Order")
If lOR = vbNo Then
MsgBox "Please select right Order Number"
Else
Application.ScreenUpdating = False
' for testing i just made it post in test sheet in same workbook
'Set Deswkbk = Workbooks.Open("\\dunton01\Inspections\TRANSPORT\New_transport\data\Febuary_2013.xls")
'Set historywks = Deswkbk.Worksheets("Data")
Set historywks = Worksheets("test")
Set LogNum = historywks.[C2]
With historywks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
If LogNum(2, 1) = "" Then
LastNum = LogNum
Else
LastNum = LogNum(LogNum.End(xlDown).Row - 1, 1)
End If
NewNum = Bulkwks.[B5] & Val(Mid(LastNum, 2)) + 1
If LogNum(2, 1) = "" Then
LogNum(2, 1) = NewNum
Else
myIn = LogNum
myLeft = Left(myIn, 1)
myMid = CInt(Mid(myIn, 2, 2))
myRight = CInt(Right(myIn, 4))
myOut = myLeft & Format(myMid, "00") & Format(myRight, "0000")
i = 0
Debug.Print "IN: " & myIn
Debug.Print "BROKEN UP: " & myOut
Do Until myMid = -1
Debug.Print "ITERATION " & Format(i, "00") & ": " & myLeft & Format(myMid, "00") & Format(myRight, "0000")
myMid = myMid - 1
myRight = myRight + 1
myOut = myLeft & Format(myMid, "00") & Format(myRight, "0000")
i = i + 1
With historywks
'enter date and time stamp in record
With .Cells(nextRow, "A")
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
End With
'enter user name in column B
.Cells(nextRow, "B").Value = Application.UserName
.Cells(nextRow, "C").Value = myIn
End With ' for testing i just disabled this Deswkbk.save
Loop
' for testing i just disabled this
'Deswkbk.Close savechanges:=True
Application.ScreenUpdating = True
Bulkwks.[E3] = NewNum
End If
' for testing i just disabled this
'Call File_In_Network_Folder
End If
End Sub
You'll need to use the myOut variable.
.Cells(nextRow, "C").Value = myOut