PDA

View Full Version : [SOLVED] Populating colums based on cell value and conditions



Aramiu
08-18-2017, 03:04 PM
Hello,

I'm new to VBA and I am trying to solve an issue with one of my excel workbooks. Hopefully I will find someone to help me with a vba code that I need.

1. I have K8, L8, M8, in which I will place data, from time to time: numbers/text, etc. When this happens, I need the content from cell K8, to populate just the cells from I24-I151 range that have "Stream1-main" on the coresponding B24-B151 range and only if the cells in the range A24-A151 do not contain the value "LIBER" (there are packages of 4 cells merged: A24-A27; A28-A31...etc, that contain this value). This should be done without any impact on the cells general or conditional formatting. The same goes for L8, populating I24-I151 range, but only when in the range B24-B151 the cells have "Stream2-motion" value and only if the cells in range A24-A151 do not contain the value "LIBER". As for M8, it will follow the same pattern, except the value for the condition on B24 - B151 is "Stream3-extra". If I delete one of these 3 cells (K8,L8,M8), the same should happen with its coresponding data from I24-I151 (just the contents, not the formating). This code should run automatically, when values are being typed inside K8/L8/M8, or deleted from them. As you probably figuered it out, on the A column there is a merge cell from 4 rows, that next, on column B split to normal, B24 = Stream1-main, B25=Stream2-motion, B26= Stream3-extra, B27 - free row

2. Something similar, but without two conditions and not running automatically is required for the following: For every cell in the D10 - D19 range, there will be a button running a script that will populate the column C24-C151 with the corresponding value of the cell, only when there is no "LIBER" encountered on the A24:A151 range.

Thank you very much for your help!

offthelip
08-18-2017, 03:38 PM
Why not do it by building up a complex if statement, the first step I have done the equation for K8, the one for L8 will be very similar, generate this in another column then copy and paste the equation into second half of the if statement. keep going for all 3 conditions.


=IF(AND(A24<>"LIBER",B24="Stream1-Main",$K$8<>""),K8,"put the second if statement in here")

Aramiu
08-18-2017, 04:03 PM
Already thought about that. Unfortunately, the cells from that target range have to be able to be manually configured also. Not only using the values from K8, L8, M8. But thanks for your reply.

Aramiu
08-18-2017, 04:11 PM
Basically, the A24:I151 array is being replicated for hundreds of times. Sometimes that target range will be populated with the same value from those 3 cells, sometimes only part of it and sometimes every row has its own value.

offthelip
08-19-2017, 01:21 AM
what about something like this (Not tested) :


Sub tst()
cola = Range(Cells(1, 1), Cells(151, 1))
colb = Range(Cells(1, 2), Cells(151, 2))
keight = Cells(8, 11)
leight = Cells(8, 12)
meight = Cells(8, 13)


For i = 24 To 151
If cola(i, 1) <> "LIBER" Then
If colb = "Stream1-Main" Then
Cells(i, 9) = keight
End If
If colb = "Stream2-Motion" Then
Cells(i, 9) = leight
End If
If colb = "Stream3-Extra" Then
Cells(i, 9) = meight
End If
End If
Next i
End Sub

Aramiu
08-19-2017, 09:44 PM
Thank you! I'm trying to run your code, but I'm getting a "Run-time error '13' : Type mismatch" on the line
If colb = "Stream1-main" Then
Maybe I need to define cola and colb as something ?

mdmackillop
08-19-2017, 11:13 PM
Please post a sample workbook

Aramiu
08-19-2017, 11:54 PM
Hello!2011820118

offthelip
08-20-2017, 02:14 AM
this works, it was my mistake I left out the index to colb


Sub tst2()




cola = Range(Cells(1, 1), Cells(151, 1))
colb = Range(Cells(1, 2), Cells(151, 2))
keight = Cells(8, 11)
leight = Cells(8, 12)
meight = Cells(8, 13)


For i = 24 To 151
If cola(i, 1) <> "LIBER" Then
If colb(i, 1) = "Stream 1 - main" Then
Cells(i, 9) = keight
End If
If colb(i, 1) = "Stream 2 - motion" Then
Cells(i, 9) = leight
End If
If colb(i, 1) = "Stream 3 - extra" Then
Cells(i, 9) = meight
End If
End If
Next i
End Sub




also put in the worksheet change event ofor sheet 1


Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Intersect(Target, Range(Cells(8, 11), Cells(8, 13))) Is Nothing) Then
Call tst2
End If




End Sub

mdmackillop
08-20-2017, 02:48 AM
Building on offthelip's code, 3 options

Sub tst1()
cola = Range(Cells(1, 1), Cells(151, 1))
colb = Range(Cells(1, 2), Cells(151, 2))
keight = Cells(8, 11)
leight = Cells(8, 12)
meight = Cells(8, 13)

For i = 24 To 148 Step 4
For j = 0 To 3
If cola(i, 1) <> "LIBER" Then
If colb(i + j, 1) = "Stream 1 - main" Then
Cells(i + j, 9) = keight
End If
If colb(i + j, 1) = "Stream 2 - motion" Then
Cells(i + j, 9) = leight
End If
If colb(i + j, 1) = "Stream 3 - extra" Then
Cells(i + j, 9) = meight
End If
End If
Next j
Next i
End Sub


Sub tst2()
cola = Range(Cells(1, 1), Cells(151, 1))
keight = Cells(8, 11)
leight = Cells(8, 12)
meight = Cells(8, 13)

For i = 24 To 148 Step 4
If cola(i, 1) <> "LIBER" Then
Cells(i + 0, 9) = keight
Cells(i + 1, 9) = leight
Cells(i + 2, 9) = meight
End If
Next i
End Sub


Sub tst3()
cola = Range(Cells(1, 1), Cells(151, 1))
Data = Cells(8, 11).Resize(, 3)

For i = 24 To 148 Step 4
If cola(i, 1) <> "LIBER" Then
Cells(i, 9).Resize(3) = Application.Transpose(Data)
End If
Next i
End Sub

Aramiu
08-20-2017, 03:18 AM
Thank you! @offthelip (http://www.vbaexpress.com/forum/member.php?60480-offthelip): The code provided does the trick, but unfortunately, the first IF in the For doesn't handle the "Stream 2" and "Stream 3" conditions. Meaning that if I put values in L8 and M8, the Macro will populate the I column. It does respect the "LIBER" condition for the K8 cell.

@mdmackillop (http://www.vbaexpress.com/forum/member.php?87-mdmackillop) I will try your options also.

Aramiu
08-20-2017, 03:46 AM
This sequence of code, inserted in Sheet1, creates a different workbook identical with the original, with some formating changes, when typing something in K8/L8/M8. Am I doing something wrong? the "Tst" sub is in a module, while the code below is in Sheet1.


Private Sub Worksheet_Change(ByVal Target As Range) If Not (Intersect(Target, Range(Cells(8, 11), Cells(8, 13))) Is Nothing) Then
Call tst2
End If
End Sub

Aramiu
08-20-2017, 03:48 AM
@mdmackillop (http://www.vbaexpress.com/forum/member.php?87-mdmackillop): first sequence works perfectly. Can it be used in conjunction with @offthelip (http://www.vbaexpress.com/forum/member.php?60480-offthelip) code for Sheet1? (I need this macro to run automaticaly when typing in K8/L8/M8, and also to delete the contents of I column, when deleting K8/L8/M8)

mdmackillop
08-20-2017, 04:09 AM
@offthelip
Issue with dreaded merged cells; Cells(25,1) does not return an answer. try MsgBox [A24] & " - " & [A25]

@Aramui
Use my code with offthelip's change event. Just add a line to clear column I

Aramiu
08-20-2017, 04:15 AM
It doesn't work...it creates another workbook, even when used in conjunction wtih your code. For every action upon the K8/L8/M8 cells, the macro creates and opens up a new workbook called "Book(1....n)".

mdmackillop
08-20-2017, 05:00 AM
Please post your code

Aramiu
08-20-2017, 05:03 AM
Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Intersect(Target, Range(Cells(8, 11), Cells(8, 13))) Is Nothing) Then
Call Tst2
End If
End Sub

mdmackillop
08-20-2017, 05:17 AM
In Sheet1 module

Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Intersect(Target, Range(Cells(8, 11), Cells(8, 13))) Is Nothing) Then
Call tst1
End If
End Sub

Private Sub tst1()
cola = Range(Cells(1, 1), Cells(151, 1))
colb = Range(Cells(1, 2), Cells(151, 2))
keight = Cells(8, 11)
leight = Cells(8, 12)
meight = Cells(8, 13)

For i = 24 To 148 Step 4
For j = 0 To 3
If cola(i, 1) <> "LIBER" Then
If colb(i + j, 1) = "Stream 1 - main" Then
Cells(i + j, 9) = keight
If keight = "" Then Cells(i + j, 10).ClearContents
End If
If colb(i + j, 1) = "Stream 2 - motion" Then
Cells(i + j, 9) = leight
If leight = "" Then Cells(i + j, 10).ClearContents
End If
If colb(i + j, 1) = "Stream 3 - extra" Then
Cells(i + j, 9) = meight
If meight = "" Then Cells(i + j, 10).ClearContents
End If
End If
Next j
Next i
End Sub

Aramiu
08-20-2017, 08:29 AM
Ok. The code runs smoothly. There is no need for that extra line for deleting column 10 (only 9 is required...I misinterpreted the code at that point). Still, there is a problem, which I have no idea how to fix: I need the information from column I to remain unchanged if I manually configure some cells in its range. So basically, only when I input data in K8/l8/M8, the I column will be populated and again if I change the values in these cells. The same goes with deleting: only if I delete the contents of those cells, the I column will be deleted (not like now, when if the cell has no value, and I click on it, it will act upon the I column, deleting its content). I know that this probably means a drastic change of the code, thinking that the issue might be from this type of line:
Cells(i + j, 9) = leight

Aramiu
08-20-2017, 08:36 AM
I made some changes in the workbook, and added some new cells. So now, the code looks like this:
And the workbook20129


Private Sub Worksheet_SelectionChange(ByVal Target As Range)



If Not (Intersect(Target, Range(Cells(10, 8), Cells(10, 15))) Is Nothing) Then
Call Copyyy
End If


End Sub
Private Sub Copyyy()


cola = Range(Cells(1, 1), Cells(151, 1))
colb = Range(Cells(1, 2), Cells(151, 2))
keight = Cells(10, 11)
leight = Cells(10, 12)
meight = Cells(10, 13)
veight = Cells(10, 14)
reight = Cells(10, 15)
zeight = Cells(10, 8)
Weight = Cells(10, 9)
Yeight = Cells(10, 10)

For i = 24 To 148 Step 4
For j = 0 To 3
If cola(i, 1) <> "LIBER" Then
If colb(i + j, 1) = "Stream 1 - main" Then
Cells(i + j, 9) = keight
Cells(i + j, 10) = veight
Cells(i + j, 6) = zeight
End If
If colb(i + j, 1) = "Stream 2 - motion" Then
Cells(i + j, 9) = leight
Cells(i + j, 10) = reight
Cells(i + j, 6) = Weight
End If
If colb(i + j, 1) = "Stream 3 - extra" Then
Cells(i + j, 9) = meight
Cells(i + j, 6) = Yeight
End If
End If
Next j
Next i
End Sub

mdmackillop
08-20-2017, 01:17 PM
Change

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

to this

Private Sub Worksheet_Change(ByVal Target As Range)

Aramiu
08-21-2017, 12:32 AM
Thank you! It is working perfectly!