- Joined
- Oct 24, 2017
- Posts
- 520
- Solutions
- 1
- Reaction
- 138
- Points
- 234
Office 16 at Chat GPT po yung gamit ko kaso para ayaw gumana nang maayos yung code ko sa excel
ang gusto ko mangyari na gumawa nang lista sa List sheet habang nag eencode ako sa main sheet, tapos pag may na encode na ako na duplicate sa main sheet nag aauto fill sya sa main sheet galing sa List sheet ang binabasihan...
1st code sa main sheet
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim LastRow As Long
Dim listSheet As Worksheet
Dim found As Boolean
Set listSheet = ThisWorkbook.Worksheets("List")
' Check if the changed cell is in column B
If Not Intersect(Target, Me.Range("B6:B" & Me.Rows.Count)) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
' Check if value is unique
For Each cell In listSheet.Range("A2:A" & listSheet.Cells(listSheet.Rows.Count, 1).End(xlUp).Row)
If cell.Value = Target.Value Then
found = True
Exit For
End If
Next cell
If found Then
' Add VLOOKUP formulas
Me.Range("C" & Target.Row).Formula = "=VLOOKUP(B" & Target.Row & ",List!$A$2:$B$" & listSheet.Cells(listSheet.Rows.Count, 1).End(xlUp).Row & ",2,FALSE)"
Me.Range("D" & Target.Row).Formula = "=VLOOKUP(B" & Target.Row & ",List!$A$2:$C$" & listSheet.Cells(listSheet.Rows.Count, 1).End(xlUp).Row & ",3,FALSE)"
Else
' Add value to list
LastRow = listSheet.Cells(listSheet.Rows.Count, 1).End(xlUp).Row + 1
listSheet.Cells(LastRow, 1).Value = Target.Value
End If
End If
End Sub
ang 2nd code sa sheet na ang pangalan "List"
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
On Error Resume Next
Application.EnableEvents = False
Dim vLookupResultB As Variant
Dim vLookupResultC As Variant
vLookupResultB = Application.VLookup(Target.Value, Sheets("Main").Range("B:C"), 2, False)
vLookupResultC = Application.VLookup(Target.Value, Sheets("Main").Range("B"), 3, False)
If Not IsError(vLookupResultB) Then
Target.Offset(0, 1).Value = vLookupResultB
Else
Target.Offset(0, 1).ClearContents
End If
If Not IsError(vLookupResultC) Then
Target.Offset(0, 2).Value = vLookupResultC
Else
Target.Offset(0, 2).ClearContents
End If
Application.EnableEvents = True
On Error GoTo 0
End If
End Sub
pag na fill up ko na sa B6 tapos C6 and D6 sa main sheet ayaw lumabas sa List na sheet, tapos na dedelete sya
*maling Code nalagay ko sa List sheet
ang gusto ko mangyari na gumawa nang lista sa List sheet habang nag eencode ako sa main sheet, tapos pag may na encode na ako na duplicate sa main sheet nag aauto fill sya sa main sheet galing sa List sheet ang binabasihan...
1st code sa main sheet
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim LastRow As Long
Dim listSheet As Worksheet
Dim found As Boolean
Set listSheet = ThisWorkbook.Worksheets("List")
' Check if the changed cell is in column B
If Not Intersect(Target, Me.Range("B6:B" & Me.Rows.Count)) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
' Check if value is unique
For Each cell In listSheet.Range("A2:A" & listSheet.Cells(listSheet.Rows.Count, 1).End(xlUp).Row)
If cell.Value = Target.Value Then
found = True
Exit For
End If
Next cell
If found Then
' Add VLOOKUP formulas
Me.Range("C" & Target.Row).Formula = "=VLOOKUP(B" & Target.Row & ",List!$A$2:$B$" & listSheet.Cells(listSheet.Rows.Count, 1).End(xlUp).Row & ",2,FALSE)"
Me.Range("D" & Target.Row).Formula = "=VLOOKUP(B" & Target.Row & ",List!$A$2:$C$" & listSheet.Cells(listSheet.Rows.Count, 1).End(xlUp).Row & ",3,FALSE)"
Else
' Add value to list
LastRow = listSheet.Cells(listSheet.Rows.Count, 1).End(xlUp).Row + 1
listSheet.Cells(LastRow, 1).Value = Target.Value
End If
End If
End Sub
ang 2nd code sa sheet na ang pangalan "List"
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
On Error Resume Next
Application.EnableEvents = False
Dim vLookupResultB As Variant
Dim vLookupResultC As Variant
vLookupResultB = Application.VLookup(Target.Value, Sheets("Main").Range("B:C"), 2, False)
vLookupResultC = Application.VLookup(Target.Value, Sheets("Main").Range("B"), 3, False)
If Not IsError(vLookupResultB) Then
Target.Offset(0, 1).Value = vLookupResultB
Else
Target.Offset(0, 1).ClearContents
End If
If Not IsError(vLookupResultC) Then
Target.Offset(0, 2).Value = vLookupResultC
Else
Target.Offset(0, 2).ClearContents
End If
Application.EnableEvents = True
On Error GoTo 0
End If
End Sub
pag na fill up ko na sa B6 tapos C6 and D6 sa main sheet ayaw lumabas sa List na sheet, tapos na dedelete sya
*maling Code nalagay ko sa List sheet
Last edited: