Insert and highlight cell

A

airbatucampur92@gmail.com

New member
Joined
Jul 9, 2014
Messages
11
Reaction score
0
Points
0
Hi all
I have two sheets; sheet1 and sheet2.
Sheet1 will be the source and sheet2 will be the result or target.
By using VBA, how can i insert and highlight cell if it meets the condition like example that i attached in file below.

the situation is:
1)if 'process' in sheet 1 is equal/contain with the process in sheet 2, copy 'title' to the empty cell according to months and year
2)after insert to suitable cell, the cell will be highlighted with red colour
3) if the cell already full, insert new cell below the existing one.

the result will look like in sheet2 that i attached below

thanks.

View attachment Book1.xlsx
 
Code: 
Public Function SetupData()Dim target As Worksheet
Dim lastrow As Long
Dim processrow As Long
Dim yearidx As Long
Dim monthidx As Long
Dim targetcol As Long
Dim i As Long
    
    Application.ScreenUpdating = False


    Set target = Worksheets("Sheet2")
    
    With Worksheets("Sheet1")
    
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To lastrow
        
            processrow = Matchup(.Cells(i, "H").value, target.Columns(1))
            If processrow > 0 Then
            
                yearidx = Year(.Cells(i, "B").value) - Application.Min(target.Rows(1))
                monthidx = Month(.Cells(i, "B").value)
                If Application.CountA(target.Rows(processrow)) > 1 Then
                
                    processrow = processrow + 1
                    target.Rows(processrow).Insert
                End If
                
                targetcol = yearidx * 12 + monthidx + 1
                target.Cells(processrow, targetcol).value = .Cells(i, "C").value
                target.Cells(processrow, targetcol).Interior.ColorIndex = 3
            End If
        Next i
    End With
    
    Application.ScreenUpdating = True
End Function


Private Function Matchup(value As Variant, rng As Range) As Long
    On Error Resume Next
    Matchup = Application.Match(value, rng, 0)
End Function
 
i already run your code and its work!!! thanks
but im still new in vba thing, so can you comment the code??? so i can understand better your code...
i really appreciate your help.

thanks again.
 
No, I am not going to comment the whole, I don't do comments, they are a waste of time in my view. You tell which bit(s) you don't understand, and I will try and explain it.
 
and another one question i wanna ask, what this code does?


Private Function Matchup(value As Variant, rng As Range) As Long On Error Resume Next Matchup = Application.Match(value, rng, 0)
 
Hi, i need your help again and really need you help.
I use your code and it is functioning. thanks btw.
the problem is, i want to filter the year.

the 'year' and 'month' row will populate manually. in the file, i already populate 2012,2013,2014,2015 and 2016.
the problem is, when user delete any of the year for example 2014, it will only populate the 2012,2013,2015 and 2016 without 2014.
means here, it only populate any year they want.

can you help me?
thanks.

View attachment saver.xlsm
 
I very much doubt it. Partly because I don't understand what your are asking, and partly because your workbook crashes my Excel.
 
sorry if i'm not explain it clearly.
this is my code and i edit certain part to meet the requirement.

my problem is, for example if i want to see result from 2014 only,
i will delete year 2012,2013,2015 and 2016 row and its month in sheet 2,
when i run the code, it only show 2014 only without populate another year's results.
same goes when i want to show year 2013 and so on.

but this coding, even i already delete year 2012,2013,2015 and 2016, it still populate also.

Code: 
Public Function SetupData()Dim target As Worksheet
Dim lastrow As Long
Dim processrow As Long
Dim yearidx As Long
Dim monthidx As Long
Dim targetcol As Long
Dim i As Long


Dim v
    v = "BAR BEE BEI BEM " 
    v = Split(v, " ")
    Range("A3").Resize(UBound(v) + 1).value = Application.Transpose(v)




Columns("A:A").Select
    With ActiveWindow
        .SplitColumn = 1
        .SplitRow = 0
    End With
    ActiveWindow.FreezePanes = True  'this code is to freeze the 1st column
    
    'code start here
    
    Application.ScreenUpdating = False
    Set target = Worksheets("Sheet2")
    
    With Worksheets("Sheet1")
    
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To lastrow
        
            processrow = Matchup(.Cells(i, "C").value, target.Columns(1))
            If processrow > 0 Then
            
                yearidx = Year(.Cells(i, "A").value) - Application.Min(target.Rows(1))
                monthidx = Month(.Cells(i, "A").value)
                If Application.CountA(target.Rows(processrow)) > 1 Then
                    processrow = processrow + 1
                    target.Rows(processrow).Insert
                End If
                
                targetcol = yearidx * 12 + monthidx + 1
                target.Cells(processrow, targetcol).value = .Cells(i, "E").value
                target.Cells(processrow, targetcol).Interior.ColorIndex = 3
                         
            End If
        Next i
    End With
    
    'this code will clear the highlighted empty cell
    Cells.Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=LEN(TRIM(A1))=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1)
    .Interior.ColorIndex = 0
        
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    
    Application.ScreenUpdating = True
End Function




Private Function Matchup(value As Variant, rng As Range) As Long
    On Error Resume Next
    Matchup = Application.Match(value, rng, 0)
End Function
View attachment test1.xlsx

can u help me?
thanks!
 
You must log in or register to reply here.
Back
Top