Hi,
I’m a VBA newbie, and at the moment I’ve got pretty stuck with the following...
I’ve got 4 Named Ranges (Sheet ZIJDE) that I want to implement like this:
col 1: Zijde -> Short version only to display in a cell (Column H)
col 2: Zijde_NL -> Long Dutch Version Merged into Sheet WEBSHOP-NL - col AG + Populate a Listbox
col 3: Zijde_FR -> Long French Version Merged into Sheet WEBSHOP-FR - col AG
col 4: Zijde_EN -> Long English Version Merged into Sheet WEBSHOP-EN - col AG
[ATTACH=JSON]{"alt":"Click image for larger version Name:\tImages.jpg Views:\t1 Size:\t100.6 KB ID:\t1198755","data-align":"none","data-attachmentid":"1198755","data-size":"full","title":"Images.jpg"}[/ATTACH]
I've already managed to populate a
listbox (Sheet ONDERDELEN - Column H) with the
Long Description (from Zijde_NL - col 2) , but cannot find a way to fill the
Active Cell with the Short Version (Sheet Zijde - col 1) after the
Listbox Long Description is selected.
And at the same time in the background I want to merge the translated Long Version (Bold) of
Dutch (Sheet WEBSHOP-NL – col AG), French (Sheet WEBSHOP-FR – col AG) & English (Sheet WEBSHOP-EN – col AG) version too.
This is my code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'Private Sub Change()
'************************* THE WEBSHOP ******************************
On Error GoTo ErrHandler
'----------------- Step 1 - ABC -> A: SKU --------------------------------------------------------
'Dim not needed if set to global (see top)!
Dim oWS As Worksheet, oWS2 As Worksheet, LastRow As Long, lastRow2 As Range, i As Long, j As Long, k As Long, m As Long, n As Long '<--- MADE GLOBAL !
Set oWS = Sheets("ONDERDELEN")
Set oWS2 = Sheets("WEBSHOP-NL")
Set oWS3 = Sheets("WEBSHOP-FR")
Set oWS4 = Sheets("WEBSHOP-EN")
LastRow = oWS.Range("A" & Rows.Count).End(xlUp).Row
' Clear All Data Before Proceeding:
On Error Resume Next
'----------------- LoopThroughSheets -------------------------------------------------------------
Dim Shts As Variant
Dim Sht As Variant
Shts = Array(oWS2, oWS3, oWS4) ' No "" needed around variable names, only for worksheetnames!
For Each Sht In Shts 'Loop Sheets Code
Sht.Range("A1").CurrentRegion.Offset(1).ClearContents
On Error GoTo 0
'----------------- PREPARE LONG VERSIONS TO BE COPIED --------------------------------------------
' SHIFT H to FR & EN RANGE:
'UCase (Format(oWS.Cells(j, "H").Value, " - &;"))
'**************************
' GOT STUCK HERE: Column H
'**************************
For j = 1 To LastRow
' HEADER - NL: product_desc -> AG
If oWS.Cells(j, "D") = "LOCATIE" Then
oWS2.Cells(j, "AG").Value = "product_desc"
'NL Concatenate & Format HI-LMNO:
ElseIf Len(oWS.Cells(j, "D")) > 0 And Len(oWS.Cells(j, "E")) > 0 Then
oWS2.Cells(j, "AG").Value = _
Application.WorksheetFunction.Proper(Format(oWS.Cells(j, "I").Value, "&;")) & _
UCase(Format(oWS.Cells(j, "H").Value, " - &;")) & _
Format(oWS.Cells(j, "N").Value, " - &;") & _
Format(oWS.Cells(j, "L").Value, " - &;") & _
UCase(Format(oWS.Cells(j, "O").Value, " - &;")) & _
Format(oWS.Cells(j, "M").Value, " - &;") & _
UCase(Format(oWS.Cells(j, "C").Value, " - &;"))
' When no SKU ->
ElseIf Len(oWS.Cells(j, "A")) = 0 Then
Sht.Cells(j, "AG").Value = ""
End If
' HEADER - FR: product_desc -> AG
If oWS.Cells(j, "D") = "LOCATIE" Then
oWS3.Cells(j, "AG").Value = "product_desc"
'FR Concatenate & Format HJ-LMNO:
ElseIf Len(oWS.Cells(j, "D")) > 0 And Len(oWS.Cells(j, "E")) > 0 Then
oWS3.Cells(j, "AG").Value = _
Application.WorksheetFunction.Proper(Format(oWS.Cells(j, "J").Value, "&;")) & _
UCase(Format(oWS.Cells(j, "H").Value, " - &;")) & _
Format(oWS.Cells(j, "N").Value, " - &;") & _
Format(oWS.Cells(j, "L").Value, " - &;") & _
UCase(Format(oWS.Cells(j, "O").Value, " - &;")) & _
Format(oWS.Cells(j, "M").Value, " - &;") & _
UCase(Format(oWS.Cells(j, "C").Value, " - &;"))
' When no SKU ->
ElseIf Len(oWS.Cells(j, "A")) = 0 Then
Sht.Cells(j, "AG").Value = ""
End If
' HEADER - EN: product_desc -> AG
If oWS.Cells(j, "D") = "LOCATIE" Then
oWS4.Cells(j, "AG").Value = "product_desc"
'EN Concatenate & Format HK-LMNO:
ElseIf Len(oWS.Cells(j, "D")) > 0 And Len(oWS.Cells(j, "E")) > 0 Then
oWS4.Cells(j, "AG").Value = _
Application.WorksheetFunction.Proper(Format(oWS.Cells(j, "K").Value, "&;")) & _
UCase(Format(oWS.Cells(j, "H").Value, " - &;")) & _
Format(oWS.Cells(j, "N").Value, " - &;") & _
Format(oWS.Cells(j, "L").Value, " - &;") & _
UCase(Format(oWS.Cells(j, "O").Value, " - &;")) & _
Format(oWS.Cells(j, "M").Value, " - &;") & _
UCase(Format(oWS.Cells(j, "C").Value, " - &;"))
' When no SKU ->
ElseIf Len(oWS.Cells(j, "A")) = 0 Then
Sht.Cells(j, "AG").Value = ""
End If
Next j
Next Sht 'End Loop Through Sheets
'---------------------------------- START ERROR HANDLING ---------------------------------------
Done:
Exit Sub
ErrorExit:
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "Nou breekt m'n klomp: Line " & Erl & vbCrLf & vbCrLf & "Error Code : " & Err.Number & " , " & Err.Description
Debug.Print Erl
Stop
Resume ErrorExit
'----------------------------------- END ERROR HANDLING ----------------------------------------
End SubHopefully someone could help me on the right track? Thank you when responding.